|
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: 30720 (0x7800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Abstract_Tree, seg_045911
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Lexical, Bounded_String, Text_Io, Simulateur_Tds,
Simulateur_Itr, Unchecked_Deallocation;
use Lexical, Bounded_String;
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
Text_Io.Put_Line ("Op Arithmetique: TYPES INCOMPATIBLES");
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
Text_Io.Put_Line ("Op Test: TYPES INCOMPATIBLES");
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
Text_Io.Put_Line ("Op Test: TYPES INCOMPATIBLES");
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 or
What_Type (Right) /= Boolean_Type then
Text_Io.Put_Line ("Op Binaire: TYPES INCOMPATIBLES");
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
Text_Io.Put_Line ("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) 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 Simulateur_Tds.Get_Symbol_Type (Name) = "ENUM" then
New_Node := new Cell (Kind => Integer_Data);
New_Node.all := (Return_Type => Enumeration_Type,
Kind => Integer_Data,
Integer_Value =>
Simulateur_Tds.Get_Value (Name));
else
if Simulateur_Tds.Get_Symbol_Type (Name) = "STRUCT" 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
Text_Io.Put_Line ("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 Simulateur_Tds.Get_Symbol_Type (Name, Extension) = "ENTIER" then
New_Node.Return_Type := Integer_Type;
else
if Simulateur_Tds.Get_Symbol_Type (Name, Extension) =
"BOOLEEN" then
New_Node.Return_Type := Boolean_Type;
else
if Simulateur_Tds.Get_Symbol_Type (Name, Extension) =
"ENUM" then
New_Node.Return_Type := Enumeration_Type;
else
Text_Io.Put_Line
("Uniquement des Entiers/Booleens/Enumeres !!!");
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 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) 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) +
Evaluate_Node (Node.Right_Node);
when Moins =>
return Evaluate_Node (Node.Left_Node) -
Evaluate_Node (Node.Right_Node);
when Mul =>
return Evaluate_Node (Node.Left_Node) *
Evaluate_Node (Node.Right_Node);
when Div =>
return Evaluate_Node (Node.Left_Node) /
Evaluate_Node (Node.Right_Node);
when others =>
null;
end case;
when Integer_Data =>
return Node.Integer_Value;
when Var_Data =>
The_Integer := Simulateur_Tds.Get_Value
(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) 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);
The_Bool2 := Evaluate_Node (Node.Right_Node);
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);
The_Integer2 := Evaluate_Node (Node.Right_Node);
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);
The_Integer2 := Evaluate_Node (Node.Right_Node);
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),
Evaluate_Node (Node.Right_Node));
when Diffr =>
return not Compare_Strings
(Evaluate_Node (Node.Left_Node),
Evaluate_Node (Node.Right_Node));
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);
when others =>
null;
end case;
when Boolean_Data =>
return Node.Boolean_Value;
when Var_Data =>
The_Bool1 := Simulateur_Tds.Get_Value
(Image (Node.Var_Name),
Image (Node.Var_Extension));
return The_Bool1;
when Instruction =>
case Node.Instruction_Name is
when Existe_Connexion =>
return True;
when Existe_Lien =>
return True;
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) 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 =>
if Simulateur_Tds.Is_Pointer (Image (Node.Var_Name)) then
return Simulateur_Tds.Get_Pointer_Reference
(Image (Node.Var_Name));
else
return Image (Node.Var_Name);
end if;
when State_Type =>
case Node.Kind is
when Instruction =>
case Node.Instruction_Name is
when Etat_Connexion =>
return "LIE";
when Etat_Lien =>
return "LIE";
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=1d
nid=14
hdr6=38
[0x00] rec0=26 rec1=00 rec2=01 rec3=032
[0x01] rec0=00 rec1=00 rec2=1a rec3=03c
[0x02] rec0=1a rec1=00 rec2=1c rec3=00e
[0x03] rec0=18 rec1=00 rec2=12 rec3=026
[0x04] rec0=20 rec1=00 rec2=1b rec3=01a
[0x05] rec0=23 rec1=00 rec2=02 rec3=020
[0x06] rec0=1f rec1=00 rec2=05 rec3=01c
[0x07] rec0=1a rec1=00 rec2=07 rec3=048
[0x08] rec0=19 rec1=00 rec2=15 rec3=070
[0x09] rec0=04 rec1=00 rec2=06 rec3=034
[0x0a] rec0=1c rec1=00 rec2=09 rec3=00a
[0x0b] rec0=1c rec1=00 rec2=08 rec3=01a
[0x0c] rec0=0c rec1=00 rec2=0a rec3=04c
[0x0d] rec0=1d rec1=00 rec2=0b rec3=062
[0x0e] rec0=24 rec1=00 rec2=0c rec3=000
[0x0f] rec0=05 rec1=00 rec2=03 rec3=016
[0x10] rec0=1d rec1=00 rec2=0d rec3=04e
[0x11] rec0=00 rec1=00 rec2=17 rec3=01a
[0x12] rec0=1d rec1=00 rec2=0e rec3=076
[0x13] rec0=1b rec1=00 rec2=0f rec3=046
[0x14] rec0=22 rec1=00 rec2=10 rec3=03c
[0x15] rec0=1e rec1=00 rec2=13 rec3=016
[0x16] rec0=19 rec1=00 rec2=1d rec3=00e
[0x17] rec0=0c rec1=00 rec2=16 rec3=014
[0x18] rec0=1e rec1=00 rec2=19 rec3=022
[0x19] rec0=1e rec1=00 rec2=18 rec3=04c
[0x1a] rec0=1c rec1=00 rec2=11 rec3=024
[0x1b] rec0=13 rec1=00 rec2=04 rec3=000
[0x1c] rec0=02 rec1=02 rec2=02 rec3=010
tail 0x217477f2c864b73c1787e 0x42a00088462060003
Free Block Chain:
0x14: 0000 00 00 00 f8 80 05 63 61 73 65 3b 05 00 1a 20 20 ┆ case; ┆