|
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: 9216 (0x2400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Primitives, seg_0389e3
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Lex, Error, Symbol, Debug, Intermediate_Code;
with Value;
package body Primitives is
procedure Parse (N : in out Binary_Tree.Node; Success : in out Boolean) is
N1 : Binary_Tree.Node;
Ok : Boolean := True;
begin
Success := True;
N1 := new Binary_Tree.Node_Structure;
case Lex.Get is
when Lex.Activer =>
Debug.Put (300);
N1.The_Type := Binary_Tree.Activer_Type;
Lex.Next;
if Lex.Current_Token_Is (Lex.Identifier) then
Debug.Put (301);
N1.S := new String'(Lex.Image);
Lex.Next;
else
Error.Append (10);
Success := False;
end if;
when Lex.Desactiver =>
Debug.Put (302);
N1.The_Type := Binary_Tree.Desactiver_Type;
Lex.Next;
if Lex.Current_Token_Is (Lex.Identifier) then
Debug.Put (303);
N1.S := new String'(Lex.Image);
Lex.Next;
else
Error.Append (10);
Success := False;
end if;
when Lex.Fixer =>
Debug.Put (304);
N1.The_Type := Binary_Tree.Fixer_Type;
Lex.Next;
if Lex.Current_Token_Is (Lex.Identifier) then
Debug.Put (305);
N1.S := new String'(Lex.Image);
Lex.Next;
if Lex.Current_Token_Is (Lex.A) then
Debug.Put (306);
Lex.Next;
Value.Parse (N1.Left_Son, Ok);
Success := Success and Ok;
else
Error.Append (12);
Success := False;
end if;
else
Error.Append (10);
Success := False;
end if;
when Lex.Evoluer =>
Debug.Put (307);
N1.The_Type := Binary_Tree.Evoluer_Type;
Lex.Next;
if Lex.Current_Token_Is (Lex.Identifier) then
Debug.Put (308);
N1.S := new String'(Lex.Image);
Lex.Next;
if Lex.Current_Token_Is (Lex.En) then
Debug.Put (309);
Lex.Next;
Value.Parse (N1.Left_Son, Ok);
if Lex.Current_Token_Is (Lex.A) then
Debug.Put (310);
Lex.Next;
Value.Parse (N1.Right_Son, Ok);
Success := Success and Ok;
end if;
else
Error.Append (13);
Success := False;
end if;
else
Error.Append (10);
Success := False;
end if;
when others =>
Error.Append (15);
Success := False;
end case;
N := N1;
end Parse;
procedure Generate_Activer (T : in out Natural;
Adress, Actor : in Natural) is
begin
Intermediate_Code.Put (Adress, Actor, T, 1);
end Generate_Activer;
procedure Generate_Desactiver (T : in out Natural;
Adress, Actor : in Natural) is
begin
Intermediate_Code.Put (Adress, Actor, T, 0);
end Generate_Desactiver;
procedure Generate_Fixer (N : Binary_Tree.Node;
T : in out Natural;
Adress, Actor : in Natural) is
Value : Natural;
The_Type : Symbol.Symbol_Type;
Ok : Boolean := True;
begin
Symbol.Get_Variable (N.Left_Son.S.all, The_Type, Value, Ok);
Intermediate_Code.Put (Adress, Actor, T, Value);
end Generate_Fixer;
procedure Generate_Evoluer (N : Binary_Tree.Node;
T : in out Natural;
Adress, Actor : in Natural) is
Value1, Value2 : Natural;
The_Type : Symbol.Symbol_Type;
Ok : Boolean := True;
begin
Symbol.Get_Variable (N.Left_Son.S.all, The_Type, Value1, Ok);
Symbol.Get_Variable (N.Right_Son.S.all, The_Type, Value2, Ok);
Intermediate_Code.Put (Adress, Actor, T, Value2, Value1);
end Generate_Evoluer;
procedure Generate
(N : Binary_Tree.Node; T : in out Natural; S : in String) is
Adress, Actor : Natural;
The_Type : Symbol.Symbol_Type;
Ok : Boolean := True;
begin
Debug.Put (44444);
Actor := Symbol.Get_Actor_Value (S, N.S.all);
case N.The_Type is
when Binary_Tree.Activer_Type =>
Generate_Activer (T, Symbol.Get_Theatre_Adress (S), Actor);
when Binary_Tree.Desactiver_Type =>
Generate_Desactiver (T, Symbol.Get_Theatre_Adress (S), Actor);
when Binary_Tree.Fixer_Type =>
Generate_Fixer (N, T, Symbol.Get_Theatre_Adress (S), Actor);
when Binary_Tree.Evoluer_Type =>
Generate_Evoluer (N, T, Symbol.Get_Theatre_Adress (S), Actor);
when others =>
null;
end case;
end Generate;
end Primitives;
nblk1=8
nid=7
hdr6=e
[0x00] rec0=1d rec1=00 rec2=01 rec3=016
[0x01] rec0=00 rec1=00 rec2=02 rec3=026
[0x02] rec0=18 rec1=00 rec2=05 rec3=02e
[0x03] rec0=18 rec1=00 rec2=03 rec3=00e
[0x04] rec0=1f rec1=00 rec2=04 rec3=06c
[0x05] rec0=1b rec1=00 rec2=08 rec3=014
[0x06] rec0=14 rec1=00 rec2=06 rec3=001
[0x07] rec0=08 rec1=4d rec2=65 rec3=31c
tail 0x21735c5ca84e685944c32 0x42a00088462060003
Free Block Chain:
0x7: 0000 00 00 02 af 80 07 3d 20 54 72 75 65 3b 07 00 0b ┆ = True; ┆