|
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 - metrics - download
Length: 11264 (0x2c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Action_List, seg_0468ff
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Text_Io;
package body Action_List is
--type Context_Backup is
-- record
-- Action_List : Compiler_Action.Acces_List;
-- Action : Compiler_Action.Object;
-- end record;
--package Context_Stack is new Stack_Generic (Context_Backup);
--Master_List : Compiler_Action.Acces_List;
--Current_Context : Context_Backup;
--Save_Stack : Context_Stack.Stack;
--The_End : Boolean;
procedure Initialize (Obj : in out Object) is
begin
Obj.The_End := False;
Compiler_Action.Create_List (Obj.Master_List);
Obj.Current_Context.Action_List := Obj.Master_List;
end Initialize;
procedure Create_If (Obj : in out Object) is
Temp_Action : Compiler_Action.Object;
begin
Compiler_Action.Create_Action (Temp_Action,
Compiler_Action.Conditional_Action);
Obj.Current_Context.Action := Temp_Action;
Context_Stack.Push (Obj.Current_Context, Obj.Save_Stack);
end Create_If;
procedure Set_Condition (Obj : in out Object; C : Dynamic_Node.Object) is
Temp_Context : Context_Backup;
begin
Temp_Context := Context_Stack.Top (Obj.Save_Stack);
Compiler_Action.Set_Argument (Temp_Context.Action,
Compiler_Action.Condition_Argument, C);
end Set_Condition;
procedure Go_In_Then (Obj : in out Object) is
Temp_Context : Context_Backup;
begin
Temp_Context := Context_Stack.Top (Obj.Save_Stack);
Obj.Current_Context.Action_List :=
Compiler_Action.Get_True_Bloc (Temp_Context.Action);
end Go_In_Then;
procedure Go_In_Else (Obj : in out Object) is
Temp_Context : Context_Backup;
begin
Temp_Context := Context_Stack.Top (Obj.Save_Stack);
Obj.Current_Context.Action_List :=
Compiler_Action.Get_False_Bloc (Temp_Context.Action);
end Go_In_Else;
procedure End_Of_If (Obj : in out Object) is
begin
Obj.Current_Context := Context_Stack.Top (Obj.Save_Stack);
Context_Stack.Pop (Obj.Save_Stack);
Compiler_Action.Add_Action (Obj.Current_Context.Action_List,
Obj.Current_Context.Action);
end End_Of_If;
procedure Create (Obj : in out Object;
With_Kind : Simple_Action) is -- changement
Temp_Action : Compiler_Action.Object;
begin
case With_Kind is
when Write_Action =>
Compiler_Action.Create_Action (Temp_Action,
Compiler_Action.Write_Action);
when Affect_Action =>
Compiler_Action.Create_Action (Temp_Action,
Compiler_Action.Affect_Action);
when Append_In_Set_Of_Word =>
Compiler_Action.Create_Action
(Temp_Action, Compiler_Action.Append_In_Set_Of_Word);
--Compiler_Action.Print_Action (Temp_Action);
when Remove_From_Set_Of_Word =>
Compiler_Action.Create_Action
(Temp_Action, Compiler_Action.Remove_From_Set_Of_Word);
--Compiler_Action.Print_Action (Temp_Action);
when Clear_Set_Of_Word =>
Compiler_Action.Create_Action
(Temp_Action, Compiler_Action.Clear_Set_Of_Word);
-- Compiler_Action.Print_Action (Temp_Action);
when Quit_Action =>
Compiler_Action.Create_Action
(Temp_Action, Compiler_Action.Quit_Action);
when others =>
null;
end case;
Obj.Current_Context.Action := Temp_Action;
Compiler_Action.Add_Action (Obj.Current_Context.Action_List,
Obj.Current_Context.Action);
end Create;
procedure Append_Argument (Obj : in out Object;
The_Argument : Dynamic_Node.Object) is
begin
case Compiler_Action.Get_Kind (Obj.Current_Context.Action) is
when Compiler_Action.Write_Action =>
Compiler_Action.Set_Argument
(Obj.Current_Context.Action,
Compiler_Action.Write_Argument, The_Argument);
when others =>
null;
end case;
end Append_Argument;
procedure Set_Argument (Obj : in out Object;
The_Argument : Dynamic_Node.Object;
In_Position : Position) is
begin
case Compiler_Action.Get_Kind (Obj.Current_Context.Action) is
when Compiler_Action.Affect_Action =>
if In_Position = Source then
Compiler_Action.Set_Argument
(Obj.Current_Context.Action,
Compiler_Action.Source_Argument, The_Argument);
else
Compiler_Action.Set_Argument
(Obj.Current_Context.Action,
Compiler_Action.Target_Argument, The_Argument);
end if;
when Compiler_Action.Append_In_Set_Of_Word =>
if In_Position = Source then
Compiler_Action.Set_Argument
(Obj.Current_Context.Action,
Compiler_Action.Source_Argument, The_Argument);
else
Compiler_Action.Set_Argument
(Obj.Current_Context.Action,
Compiler_Action.Target_Argument, The_Argument);
end if;
when Compiler_Action.Remove_From_Set_Of_Word =>
if In_Position = Source then
Compiler_Action.Set_Argument
(Obj.Current_Context.Action,
Compiler_Action.Source_Argument, The_Argument);
else
Compiler_Action.Set_Argument
(Obj.Current_Context.Action,
Compiler_Action.Target_Argument, The_Argument);
end if;
when Compiler_Action.Clear_Set_Of_Word =>
if In_Position = Target then
Compiler_Action.Set_Argument
(Obj.Current_Context.Action,
Compiler_Action.Target_Argument, The_Argument);
end if;
when others =>
null;
end case;
end Set_Argument;
procedure Evaluate (Obj : in out Object) is
begin
Compiler_Action.Evaluate (Obj.Master_List);
end Evaluate;
procedure Execute (Obj : in out Object) is
begin
Compiler_Action.Execute (Obj.Master_List);
exception
when Compiler_Action.End_Of_Program =>
Obj.The_End := True;
end Execute;
function Is_End (Obj : in Object) return Boolean is
begin
return Obj.The_End;
end Is_End;
end Action_List;
nblk1=a
nid=2
hdr6=12
[0x00] rec0=20 rec1=00 rec2=01 rec3=004
[0x01] rec0=19 rec1=00 rec2=0a rec3=046
[0x02] rec0=1a rec1=00 rec2=04 rec3=008
[0x03] rec0=16 rec1=00 rec2=09 rec3=02c
[0x04] rec0=04 rec1=00 rec2=06 rec3=030
[0x05] rec0=17 rec1=00 rec2=07 rec3=058
[0x06] rec0=16 rec1=00 rec2=08 rec3=02e
[0x07] rec0=1d rec1=00 rec2=05 rec3=008
[0x08] rec0=09 rec1=00 rec2=03 rec3=000
[0x09] rec0=f1 rec1=0c rec2=7c rec3=772
tail 0x215433e6a86515d5b83fa 0x42a00088462060003
Free Block Chain:
0x2: 0000 00 00 00 7d 80 0b 6e 64 5f 4f 66 5f 49 66 20 69 ┆ } nd_Of_If i┆