|
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: 40960 (0xa000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Abstract_Tree, seg_0469eb
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Lexical, Bounded_String, Text_Io, Simulateur_Tds,
Simulateur_Itr, Unchecked_Deallocation, Erreur;
with Models, Symbols, Set_Of_Connections, Set_Of_Links;
use Lexical, Bounded_String, Set_Of_Connections, Set_Of_Links;
package body Abstract_Tree is
procedure Free is new Unchecked_Deallocation (Cell, Object);
procedure Destroy (Node : in out Object) is
begin
case Node.Kind is
when Binary_Operator =>
Destroy (Node.Right_Node);
Destroy (Node.Left_Node);
Free (Node);
when Unary_Operator =>
Destroy (Node.Down_Node);
Free (Node);
when Integer_Data | Boolean_Data | State_Data |
Var_Data | Instruction | Player_Entry =>
Free (Node);
end case;
end Destroy;
function Make_Node
(Operation : Token; Left, Right : Object) return Object is
The_Cell : Cell;
New_Node : Object;
begin
New_Node := new Cell (Kind => Binary_Operator);
case Operation is
when Plus | Moins | Mul | Div =>
New_Node.all := (Return_Type => Integer_Type,
Kind => Binary_Operator,
Binary_Kind => Operation,
Left_Node => Left,
Right_Node => Right);
if What_Type (Left) /= Integer_Type or
What_Type (Right) /= Integer_Type then
Erreur.Alerte ("Op Arithmetique: TYPES INCOMPATIBLES (" &
Token'Image (Operation) & ")");
end if;
when Equ | Diffr =>
New_Node.all := (Return_Type => Boolean_Type,
Kind => Binary_Operator,
Binary_Kind => Operation,
Left_Node => Left,
Right_Node => Right);
if What_Type (Left) /= What_Type (Right) then
Erreur.Alerte ("Op Test: TYPES INCOMPATIBLES (" &
Token'Image (Operation) & ")");
end if;
when Inf | Infequ | Sup | Supequ =>
New_Node.all := (Return_Type => Boolean_Type,
Kind => Binary_Operator,
Binary_Kind => Operation,
Left_Node => Left,
Right_Node => Right);
if What_Type (Left) /= Integer_Type or
What_Type (Right) /= Integer_Type then
Erreur.Alerte ("Op Test: TYPES INCOMPATIBLES (" &
Token'Image (Operation) & ")");
end if;
when Et | Ou =>
New_Node.all := (Return_Type => Boolean_Type,
Kind => Binary_Operator,
Binary_Kind => Operation,
Left_Node => Left,
Right_Node => Right);
if (What_Type (Left) /= Boolean_Type and
What_Type (Left) /= Entry_Type) or
(What_Type (Right) /= Boolean_Type and
What_Type (Right) /= Entry_Type) then
Erreur.Alerte ("Op Binaire: TYPES INCOMPATIBLES (" &
Token'Image (Operation) & ")");
end if;
when others =>
null;
end case;
return New_Node;
end Make_Node;
function Make_Node (Operation : Token; Down : Object) return Object is
New_Node : Object;
begin
New_Node := new Cell (Kind => Unary_Operator);
case Operation is
when Non =>
New_Node.all := (Return_Type => Boolean_Type,
Kind => Unary_Operator,
Unary_Kind => Operation,
Down_Node => Down);
if What_Type (Down) /= Boolean_Type then
Erreur.Alerte ("Op Unaire: TYPES INCOMPATIBLES");
end if;
when others =>
null;
end case;
return New_Node;
end Make_Node;
function Make_Node (Value : Integer) return Object is
New_Node : Object;
begin
New_Node := new Cell (Kind => Integer_Data);
New_Node.all := (Return_Type => Integer_Type,
Kind => Integer_Data,
Integer_Value => Value);
return New_Node;
end Make_Node;
function Make_Node (Value : Token) return Object is
New_Node : Object;
begin
case Value is
when Lie | Delie =>
New_Node := new Cell (State_Data);
New_Node.all := (Return_Type => State_Type,
Kind => State_Data,
State_Value => Value);
when Vrai =>
New_Node := new Cell (Boolean_Data);
New_Node.all := (Return_Type => Boolean_Type,
Kind => Boolean_Data,
Boolean_Value => True);
when Faux =>
New_Node := new Cell (Boolean_Data);
New_Node.all := (Return_Type => Boolean_Type,
Kind => Boolean_Data,
Boolean_Value => False);
when others =>
null;
end case;
return New_Node;
end Make_Node;
function Make_Node (Name, Extension : String;
Models_Table : Models.Object;
Symbols_Table : Symbols.Object) return Object is
New_Node : Object;
The_Name, The_Extension : Variable_String (32);
begin
Bounded_String.Free (The_Name);
Bounded_String.Copy (The_Name, Name);
Bounded_String.Free (The_Extension);
Bounded_String.Copy (The_Extension, Extension);
if Bounded_String.Length (The_Extension) = 0 then
if Symbols.Get_Symbol_Type (Symbols_Table, Models_Table, Name) =
"ENUMERE" then
New_Node := new Cell (Kind => Integer_Data);
New_Node.all :=
(Return_Type => Enumeration_Type,
Kind => Integer_Data,
Integer_Value =>
Symbols.Get_Symbol_Value
(Symbols_Table, Models_Table, Name, Name));
else
if Symbols.Get_Symbol_Type (Symbols_Table, Models_Table, Name) =
"STRUCTURE" then
New_Node := new Cell (Var_Data);
New_Node.all := (Return_Type => Struct_Type,
Kind => Var_Data,
Var_Name => The_Name,
Var_Extension => The_Extension);
else
Erreur.Alerte ("Manque Extension !!!");
end if;
end if;
else
New_Node := new Cell (Var_Data);
New_Node.all := (Return_Type => Other_Type,
Kind => Var_Data,
Var_Name => The_Name,
Var_Extension => The_Extension);
if Symbols.Get_Symbol_Type
(Symbols_Table, Models_Table, Name, Extension) = "ENTIER" then
New_Node.Return_Type := Integer_Type;
else
if Symbols.Get_Symbol_Type
(Symbols_Table, Models_Table, Name, Extension) =
"BOOLEEN" then
New_Node.Return_Type := Boolean_Type;
else
if Symbols.Get_Symbol_Type
(Symbols_Table, Models_Table, Name, Extension) =
"ENUMERE" then
New_Node.Return_Type := Enumeration_Type;
else
Erreur.Alerte
("Uniquement des Entiers/Booleens/Enumeres dans les expressions!!!");
end if;
end if;
end if;
end if;
return New_Node;
end Make_Node;
function Make_Node (Name : Token; Param1, Param2 : String) return Object is
New_Node : Object;
The_Param1, The_Param2 : Variable_String (32);
begin
New_Node := new Cell (Kind => Instruction);
Bounded_String.Free (The_Param1);
Bounded_String.Copy (The_Param1, Param1);
Bounded_String.Free (The_Param2);
Bounded_String.Copy (The_Param2, Param2);
case Name is
when Existe_Connexion | Existe_Lien =>
New_Node.all := (Return_Type => Boolean_Type,
Kind => Instruction,
Instruction_Name => Name,
Param1 => The_Param1,
Param2 => The_Param2);
when Etat_Connexion | Etat_Lien =>
New_Node.all := (Return_Type => State_Type,
Kind => Instruction,
Instruction_Name => Name,
Param1 => The_Param1,
Param2 => The_Param2);
when Destination_Connexion =>
New_Node.all := (Return_Type => Struct_Type,
Kind => Instruction,
Instruction_Name => Name,
Param1 => The_Param1,
Param2 => The_Param2);
when others =>
null;
end case;
return New_Node;
end Make_Node;
function Make_Node (Entry1, Entry2, Entry3 : String) return Object is
New_Node : Object;
Entry_Count : Integer;
The_Entry1, The_Entry2, The_Entry3 : Variable_String (32);
begin
New_Node := new Cell (Kind => Player_Entry);
Bounded_String.Free (The_Entry1);
Bounded_String.Copy (The_Entry1, Entry1);
Bounded_String.Free (The_Entry2);
Bounded_String.Copy (The_Entry2, Entry2);
Bounded_String.Free (The_Entry3);
Bounded_String.Copy (The_Entry3, Entry3);
Entry_Count := 0;
if Bounded_String.Length (The_Entry1) > 0 then
Entry_Count := 1;
if Bounded_String.Length (The_Entry2) > 0 then
Entry_Count := 2;
if Bounded_String.Length (The_Entry3) > 0 then
Entry_Count := 3;
end if;
end if;
end if;
New_Node.all := (Return_Type => Entry_Type,
Kind => Player_Entry,
Nb_Param => Entry_Count,
Entry1 => The_Entry1,
Entry2 => The_Entry2,
Entry3 => The_Entry3);
return New_Node;
end Make_Node;
function Evaluate_Node (Node : Object;
Models_Table : Models.Object;
Symbols_Table : Symbols.Object;
Connect : Set_Of_Connections.Object;
Links : Set_Of_Links.Object) return Integer is
The_Integer : Integer;
begin
if Node.Return_Type /= Integer_Type and
Node.Return_Type /= Enumeration_Type then
raise Bad_Type;
end if;
case Node.Kind is
when Binary_Operator =>
case Node.Binary_Kind is
when Plus =>
return Evaluate_Node (Node.Left_Node, Models_Table,
Symbols_Table, Connect, Links) +
Evaluate_Node (Node.Right_Node, Models_Table,
Symbols_Table, Connect, Links);
when Moins =>
return Evaluate_Node (Node.Left_Node, Models_Table,
Symbols_Table, Connect, Links) -
Evaluate_Node (Node.Right_Node, Models_Table,
Symbols_Table, Connect, Links);
when Mul =>
return Evaluate_Node (Node.Left_Node, Models_Table,
Symbols_Table, Connect, Links) *
Evaluate_Node (Node.Right_Node, Models_Table,
Symbols_Table, Connect, Links);
when Div =>
return Evaluate_Node (Node.Left_Node, Models_Table,
Symbols_Table, Connect, Links) /
Evaluate_Node (Node.Right_Node, Models_Table,
Symbols_Table, Connect, Links);
when others =>
null;
end case;
when Integer_Data =>
return Node.Integer_Value;
when Var_Data =>
The_Integer := Symbols.Get_Symbol_Value
(Symbols_Table, Models_Table,
Image (Node.Var_Name),
Image (Node.Var_Extension));
return The_Integer;
when others =>
null;
end case;
end Evaluate_Node;
function Compare_Strings (A, B : String) return Boolean is
begin
return A = B;
end Compare_Strings;
function Evaluate_Node (Node : Object;
Models_Table : Models.Object;
Symbols_Table : Symbols.Object;
Connect : Set_Of_Connections.Object;
Links : Set_Of_Links.Object) return Boolean is
The_Bool1, The_Bool2 : Boolean;
The_Integer1, The_Integer2 : Integer;
begin
if Node.Return_Type /= Boolean_Type and
Node.Return_Type /= Entry_Type then
raise Bad_Type;
end if;
case Node.Kind is
when Binary_Operator =>
case Node.Left_Node.Return_Type is
when Boolean_Type =>
The_Bool1 := Evaluate_Node
(Node.Left_Node, Models_Table,
Symbols_Table, Connect, Links);
The_Bool2 := Evaluate_Node
(Node.Right_Node, Models_Table,
Symbols_Table, Connect, Links);
case Node.Binary_Kind is
when Equ =>
return The_Bool1 = The_Bool2;
when Diffr =>
return The_Bool1 /= The_Bool2;
when Et =>
return The_Bool1 and The_Bool2;
when Ou =>
return The_Bool1 or The_Bool2;
when others =>
null;
end case;
when Integer_Type =>
The_Integer1 := Evaluate_Node
(Node.Left_Node, Models_Table,
Symbols_Table, Connect, Links);
The_Integer2 := Evaluate_Node
(Node.Right_Node, Models_Table,
Symbols_Table, Connect, Links);
case Node.Binary_Kind is
when Equ =>
return The_Integer1 = The_Integer2;
when Diffr =>
return The_Integer1 /= The_Integer2;
when Inf =>
return The_Integer1 < The_Integer2;
when Infequ =>
return The_Integer1 <= The_Integer2;
when Sup =>
return The_Integer1 > The_Integer2;
when Supequ =>
return The_Integer1 >= The_Integer2;
when others =>
null;
end case;
when Enumeration_Type =>
The_Integer1 := Evaluate_Node
(Node.Left_Node, Models_Table,
Symbols_Table, Connect, Links);
The_Integer2 := Evaluate_Node
(Node.Right_Node, Models_Table,
Symbols_Table, Connect, Links);
case Node.Binary_Kind is
when Equ =>
return The_Integer1 = The_Integer2;
when Diffr =>
return The_Integer1 /= The_Integer2;
when others =>
null;
end case;
when State_Type | Struct_Type =>
case Node.Binary_Kind is
when Equ =>
return Compare_Strings
(Evaluate_Node
(Node.Left_Node, Models_Table,
Symbols_Table, Connect, Links),
Evaluate_Node
(Node.Right_Node, Models_Table,
Symbols_Table, Connect, Links));
when Diffr =>
return not Compare_Strings
(Evaluate_Node
(Node.Left_Node,
Models_Table, Symbols_Table,
Connect, Links),
Evaluate_Node
(Node.Right_Node,
Models_Table, Symbols_Table,
Connect, Links));
when others =>
null;
end case;
when others =>
null;
end case;
when Unary_Operator =>
case Node.Unary_Kind is
when Non =>
return not Evaluate_Node
(Node.Down_Node, Models_Table,
Symbols_Table, Connect, Links);
when others =>
null;
end case;
when Boolean_Data =>
return Node.Boolean_Value;
when Var_Data =>
The_Bool1 := Symbols.Get_Symbol_Value
(Symbols_Table, Models_Table,
Image (Node.Var_Name),
Image (Node.Var_Extension));
return The_Bool1;
when Instruction =>
case Node.Instruction_Name is
when Existe_Connexion =>
if Image (Node.Param1) = "COMP" then
return Set_Of_Connections.Exist
(Simulateur_Itr.First_Comp_Value,
Image (Node.Param2), Connect);
else
if Image (Node.Param2) = "COMP" then
return Set_Of_Connections.Exist
(Image (Node.Param1),
Simulateur_Itr.First_Comp_Value,
Connect);
end if;
end if;
return Set_Of_Connections.Exist
(Image (Node.Param1),
Image (Node.Param2), Connect);
when Existe_Lien =>
if Image (Node.Param1) = "COMP" then
return Set_Of_Links.Exist
(Simulateur_Itr.First_Comp_Value,
Image (Node.Param2), Links);
else
if Image (Node.Param2) = "COMP" then
return Set_Of_Links.Exist
(Image (Node.Param1),
Simulateur_Itr.First_Comp_Value,
Links);
end if;
end if;
return Set_Of_Links.Exist (Image (Node.Param1),
Image (Node.Param2), Links);
when others =>
null;
end case;
when Player_Entry =>
if Simulateur_Itr.Number_Of_Entries = Node.Nb_Param then
return Simulateur_Itr.Is_Entry
(Image (Node.Entry1), Image (Node.Entry2),
Image (Node.Entry3));
else
return False;
end if;
when others =>
null;
end case;
end Evaluate_Node;
function Evaluate_Node (Node : Object;
Models_Table : Models.Object;
Symbols_Table : Symbols.Object;
Connect : Set_Of_Connections.Object;
Links : Set_Of_Links.Object) return String is
begin
if Node.Return_Type /= Struct_Type and
Node.Return_Type /= State_Type then
raise Bad_Type;
end if;
case Node.Return_Type is
when Struct_Type =>
case Node.Kind is
when Instruction =>
if Image (Node.Param1) = "COMP" then
return Set_Of_Connections.What_Destination
(Simulateur_Itr.First_Comp_Value,
Image (Node.Param2), Connect);
else
if Image (Node.Param2) = "COMP" then
return Set_Of_Connections.What_Destination
(Image (Node.Param1),
Simulateur_Itr.First_Comp_Value,
Connect);
end if;
end if;
return Set_Of_Connections.What_Destination
(Image (Node.Param1),
Image (Node.Param2), Connect);
when Var_Data =>
if Symbols.Is_Pointer (Symbols_Table,
Image (Node.Var_Name)) then
return Symbols.Get_Pointer_Reference
(Symbols_Table, Image (Node.Var_Name));
else
return Image (Node.Var_Name);
end if;
when others =>
null;
end case;
when State_Type =>
case Node.Kind is
when Instruction =>
case Node.Instruction_Name is
when Etat_Connexion =>
if Image (Node.Param1) = "COMP" then
if Set_Of_Connections.What_State
(Simulateur_Itr.First_Comp_Value,
Image (Node.Param2), Connect) =
Linked then
return "LIE";
else
return "DELIE";
end if;
else
if Image (Node.Param2) = "COMP" then
if Set_Of_Connections.What_State
(Image (Node.Param1),
Simulateur_Itr.First_Comp_Value,
Connect) = Linked then
return "LIE";
else
return "DELIE";
end if;
end if;
end if;
if Set_Of_Connections.What_State
(Image (Node.Param1),
Image (Node.Param2), Connect) =
Linked then
return "LIE";
else
return "DELIE";
end if;
when Etat_Lien =>
if Image (Node.Param1) = "COMP" then
if Set_Of_Links.What_State
(Simulateur_Itr.First_Comp_Value,
Image (Node.Param2), Links) =
Linked then
return "LIE";
else
return "DELIE";
end if;
else
if Image (Node.Param2) = "COMP" then
if Set_Of_Links.What_State
(Image (Node.Param1),
Simulateur_Itr.First_Comp_Value,
Links) = Linked then
return "LIE";
else
return "DELIE";
end if;
end if;
end if;
if Set_Of_Links.What_State
(Image (Node.Param1),
Image (Node.Param2), Links) = Linked then
return "LIE";
else
return "DELIE";
end if;
when others =>
null;
end case;
when State_Data =>
return Token'Image (Node.State_Value);
when others =>
null;
end case;
when others =>
null;
end case;
end Evaluate_Node;
procedure Dump_Spaces (Nb : Integer) is
begin
for I in 1 .. Nb loop
Text_Io.Put (" ");
end loop;
end Dump_Spaces;
procedure Dump_Struct (Nb : Integer; Node : Object) is
begin
case Node.Kind is
when Binary_Operator =>
Dump_Struct (Nb + 2, Node.Left_Node);
Dump_Spaces (Nb);
case Node.Binary_Kind is
when Plus =>
Text_Io.Put_Line ("+");
when Moins =>
Text_Io.Put_Line ("-");
when Mul =>
Text_Io.Put_Line ("*");
when Div =>
Text_Io.Put_Line ("/");
when Equ =>
Text_Io.Put_Line ("=");
when Diffr =>
Text_Io.Put_Line ("<>");
when Inf =>
Text_Io.Put_Line ("<");
when Sup =>
Text_Io.Put_Line (">");
when Infequ =>
Text_Io.Put_Line ("<=");
when Supequ =>
Text_Io.Put_Line (">=");
when Et =>
Text_Io.Put_Line ("ET");
when Ou =>
Text_Io.Put_Line ("OU");
when others =>
null;
end case;
Dump_Struct (Nb + 2, Node.Right_Node);
when Unary_Operator =>
Dump_Spaces (Nb);
Text_Io.Put_Line ("NON");
Dump_Struct (Nb + 2, Node.Down_Node);
when Integer_Data =>
Dump_Spaces (Nb);
Text_Io.Put_Line (Integer'Image (Node.Integer_Value) & " (" &
Node_Type'Image (Node.Return_Type) & ")");
when Boolean_Data =>
Dump_Spaces (Nb);
Text_Io.Put_Line (Boolean'Image (Node.Boolean_Value));
when Var_Data =>
Dump_Spaces (Nb);
if Bounded_String.Length (Node.Var_Extension) = 0 then
Text_Io.Put (Image (Node.Var_Name));
else
Text_Io.Put (Image (Node.Var_Name) & "." &
Image (Node.Var_Extension));
end if;
Text_Io.Put_Line (" (" &
Node_Type'Image (Node.Return_Type) & ")");
when State_Data =>
Dump_Spaces (Nb);
Text_Io.Put_Line (Token'Image (Node.State_Value));
when Instruction =>
Dump_Spaces (Nb);
Text_Io.Put (Token'Image (Node.Instruction_Name) & "(");
Text_Io.Put (Image (Node.Param1) & ",");
Text_Io.Put_Line (Image (Node.Param2) & ")");
when Player_Entry =>
Dump_Spaces (Nb);
Text_Io.Put ("[" & Image (Node.Entry1));
Text_Io.Put (" " & Image (Node.Entry2));
Text_Io.Put_Line (" " & Image (Node.Entry3) & "]");
end case;
end Dump_Struct;
procedure Dump (Node : Object) is
begin
Dump_Struct (0, Node);
end Dump;
function What_Type (Node : Object) return Node_Type is
begin
return Node.Return_Type;
end What_Type;
end Abstract_Tree;
nblk1=27
nid=f
hdr6=4a
[0x00] rec0=23 rec1=00 rec2=01 rec3=08c
[0x01] rec0=04 rec1=00 rec2=23 rec3=022
[0x02] rec0=18 rec1=00 rec2=1a rec3=02c
[0x03] rec0=18 rec1=00 rec2=1b rec3=012
[0x04] rec0=1e rec1=00 rec2=1c rec3=01c
[0x05] rec0=22 rec1=00 rec2=1e rec3=008
[0x06] rec0=1e rec1=00 rec2=02 rec3=044
[0x07] rec0=19 rec1=00 rec2=05 rec3=080
[0x08] rec0=1c rec1=00 rec2=15 rec3=012
[0x09] rec0=14 rec1=00 rec2=03 rec3=04e
[0x0a] rec0=1a rec1=00 rec2=06 rec3=018
[0x0b] rec0=1d rec1=00 rec2=09 rec3=026
[0x0c] rec0=1b rec1=00 rec2=08 rec3=046
[0x0d] rec0=19 rec1=00 rec2=14 rec3=06c
[0x0e] rec0=15 rec1=00 rec2=24 rec3=01e
[0x0f] rec0=06 rec1=00 rec2=0a rec3=03e
[0x10] rec0=21 rec1=00 rec2=17 rec3=010
[0x11] rec0=19 rec1=00 rec2=25 rec3=02e
[0x12] rec0=19 rec1=00 rec2=26 rec3=052
[0x13] rec0=1a rec1=00 rec2=0b rec3=010
[0x14] rec0=18 rec1=00 rec2=0d rec3=012
[0x15] rec0=19 rec1=00 rec2=10 rec3=056
[0x16] rec0=0f rec1=00 rec2=0e rec3=030
[0x17] rec0=14 rec1=00 rec2=0c rec3=054
[0x18] rec0=13 rec1=00 rec2=13 rec3=07e
[0x19] rec0=1c rec1=00 rec2=07 rec3=04e
[0x1a] rec0=00 rec1=00 rec2=1d rec3=006
[0x1b] rec0=16 rec1=00 rec2=22 rec3=018
[0x1c] rec0=16 rec1=00 rec2=21 rec3=06c
[0x1d] rec0=11 rec1=00 rec2=12 rec3=00e
[0x1e] rec0=13 rec1=00 rec2=20 rec3=068
[0x1f] rec0=12 rec1=00 rec2=1f rec3=03e
[0x20] rec0=18 rec1=00 rec2=16 rec3=014
[0x21] rec0=1e rec1=00 rec2=19 rec3=022
[0x22] rec0=1e rec1=00 rec2=18 rec3=04c
[0x23] rec0=1c rec1=00 rec2=11 rec3=024
[0x24] rec0=13 rec1=00 rec2=04 rec3=000
[0x25] rec0=13 rec1=00 rec2=04 rec3=000
[0x26] rec0=80 rec1=80 rec2=80 rec3=404
tail 0x2154357fc865171656536 0x42a00088462060003
Free Block Chain:
0xf: 0000 00 27 01 53 80 1d 20 20 20 72 65 74 75 72 6e 20 ┆ ' S return ┆
0x27: 0000 00 00 00 08 80 05 61 6d 65 29 2c 05 00 00 00 00 ┆ ame), ┆