|
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: 18432 (0x4800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Abstract_Tree, seg_044c61
└─⟦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;
use Lexical, Bounded_String;
package body Abstract_Tree is
function Make_Node
(Operation : Token; Left, Right : Object) return Object is
New_Node : Object;
begin
New_Node := new Cell;
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);
when Equ | Diffr | Inf | Infequ | Sup | Supequ =>
New_Node.all := (Return_Type => Boolean_Type,
Kind => Binary_Operator,
Binary_Kind => Operation,
Left_Node => Left,
Right_Node => Right); when Et | Ou =>
New_Node.all := (Return_Type => Boolean_Type,
Kind => Binary_Operator,
Binary_Kind => Operation,
Left_Node => Left,
Right_Node => Right);
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;
case Operation is
when Non =>
New_Node.all := (Return_Type => Boolean_Type,
Kind => Unary_Operator,
Unary_Kind => Operation,
Down_Node => Down);
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;
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
New_Node := new Cell;
case Value is
when Lie | Delie =>
New_Node.all := (Return_Type => State_Type,
Kind => State_Data,
State_Value => Value);
when Vrai =>
New_Node.all := (Return_Type => Boolean_Type,
Kind => Boolean_Data,
Boolean_Value => True);
when Faux =>
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
begin
[statement]
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;
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;
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;
procedure Destroy (Node : in out Object) is
begin
[statement]
end Destroy;
function Evaluate_Node (Node : Object) return Integer is
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 =>
if What_Type (Node.Left_Node) /= Integer_Type or
What_Type (Node.Right_Node) /= Integer_Type then
raise Bad_Type;
end if;
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 =>
null; -- A completer !!!
when others =>
null;
end case;
end Evaluate_Node;
function Evaluate_Node (Node : Object) return Boolean is
begin
if Node.Return_Type /= Boolean_Type then
raise Bad_Type;
end if;
case Node.Kind is
when Binary_Operator =>
if What_Type (Node.Left_Node) /=
What_Type (Node.Right_Node) then
raise Bad_Type;
end if;
case Node.Return_Type is
when Boolean_Type =>
case Node.Binary_Kind is
when Equ =>
return Evaluate_Node (Node.Left_Node) =
Evaluate_Node (Node.Right_Node);
when Diffr =>
return Boolean'Evaluate_Node (Node.Left_Node) /=
Boolean'Evaluate_Node
(Node.Right_Node);
when Et =>
return Evaluate_Node (Node.Left_Node) and
Evaluate_Node (Node.Right_Node);
when Ou =>
return Evaluate_Node (Node.Left_Node) or
Evaluate_Node (Node.Right_Node);
when others =>
raise Bad_Type;
end case;
when Integer_Type =>
case Node.Binary_Kind is
when Equ =>
return Integer'Evaluate_Node (Node.Left_Node) =
Integer'Evaluate_Node
(Node.Right_Node);
when Diffr =>
return Integer'Evaluate_Node (Node.Left_Node) /=
Integer'Evaluate_Node
(Node.Right_Node);
when Inf =>
return Integer'Evaluate_Node (Node.Left_Node) <
Integer'Evaluate_Node
(Node.Right_Node);
when Infequ =>
return Integer'Evaluate_Node (Node.Left_Node) <=
Integer'Evaluate_Node
(Node.Right_Node);
when Sup =>
return Integer'Evaluate_Node (Node.Left_Node) >
Integer'Evaluate_Node
(Node.Right_Node);
when Supequ =>
return Integer'Evaluate_Node (Node.Left_Node) >=
Integer'Evaluate_Node
(Node.Right_Node);
when others =>
raise Bad_Type;
end case;
when Enumeration_Type =>
case Node.Binary_Kind is
when Equ =>
return Integer'Evaluate_Node (Node.Left_Node) =
Integer'Evaluate_Node
(Node.Right_Node);
when Diffr =>
return Integer'Evaluate_Node (Node.Left_Node) /=
Integer'Evaluate_Node
(Node.Right_Node);
when others =>
raise Bad_Type;
end case;
when State_Type | Struct_Type =>
case Node.Binary_Kind is
when Equ =>
return String'Evaluate_Node (Node.Left_Node) =
Integer'Evaluate_Node
(Node.Right_Node);
when Diffr =>
return String'Evaluate_Node (Node.Left_Node) /=
Integer'Evaluate_Node
(Node.Right_Node);
when others =>
raise Bad_Type;
end case;
when others =>
null;
end case;
when Unary_Operator =>
case Node.Unary_Kind is
when Non =>
if What_Type (Node.Down_Node) = Boolean_Type then
return not Evaluate_Node (Node.Down_Node);
else
raise Bad_Type;
end if;
when others =>
null;
end case;
when Boolean_Data =>
return Node.Boolean_Value;
when Var_Data =>
null; -- A completer !
when Player_Entry =>
null; -- A completer !
when others =>
null;
end case;
end Evaluate_Node;
function Evaluate_Node (Node : Object) return String is
begin
[statement]
end Evaluate_Node;
function What_Type (Node : Object) return Node_Type is
begin
return Node.Return_Type;
end What_Type;
procedure Dump (Node : Object) is
begin
[statement]
end Dump;
end Abstract_Tree;
nblk1=11
nid=11
hdr6=1c
[0x00] rec0=1b rec1=00 rec2=01 rec3=002
[0x01] rec0=1d rec1=00 rec2=02 rec3=022
[0x02] rec0=1d rec1=00 rec2=05 rec3=07a
[0x03] rec0=1e rec1=00 rec2=08 rec3=04a
[0x04] rec0=1a rec1=00 rec2=0f rec3=01c
[0x05] rec0=1e rec1=00 rec2=04 rec3=034
[0x06] rec0=18 rec1=00 rec2=03 rec3=06e
[0x07] rec0=24 rec1=00 rec2=07 rec3=00c
[0x08] rec0=12 rec1=00 rec2=10 rec3=07c
[0x09] rec0=16 rec1=00 rec2=0b rec3=072
[0x0a] rec0=16 rec1=00 rec2=0d rec3=04e
[0x0b] rec0=15 rec1=00 rec2=0c rec3=068
[0x0c] rec0=19 rec1=00 rec2=09 rec3=00c
[0x0d] rec0=1f rec1=00 rec2=0a rec3=000
[0x0e] rec0=0e rec1=00 rec2=11 rec3=000
[0x0f] rec0=0e rec1=00 rec2=0a rec3=000
[0x10] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x21746049a8643547388e0 0x42a00088462060003
Free Block Chain:
0x11: 0000 00 06 00 a9 80 07 6e 5f 54 79 70 65 3b 07 00 12 ┆ n_Type; ┆
0x6: 0000 00 0e 03 fc 80 25 20 20 20 20 20 20 20 20 20 20 ┆ % ┆
0xe: 0000 00 00 00 0f 00 00 00 00 00 00 00 00 00 00 00 00 ┆ ┆