|
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 Motor, seg_048176
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Text_Io, Bounded_String, Pieces, Actions,
Directions, Int_Lib, Struct_Component, String_Table;
package body Motor is
procedure Go is
Ok : Boolean;
begin
Execute_Liste (Liste_Globale, Mode_All, Ok);
Execute_Liste (Liste_Locale, Mode_First, Ok);
if not Ok then
Execute_Liste (Liste_Pseudo_Globale, Mode_First, Ok);
if not Ok then
Text_Io.Put_Line ("... action impossible !?!");
end if;
end if;
end Go;
procedure Execute_Liste (Liste : Feuille.Liste_Instr.List;
M : Mode;
Ok : in out Boolean) is
Iter : Feuille.Liste_Instr.Listiter;
Executed : Boolean := False;
begin
Iter := Feuille.Liste_Instr.Makelistiter (Liste);
while (Feuille.Liste_Instr.More (Iter) and not Executed) loop
Executed := Execute_Instr (Feuille.Liste_Instr.Cellvalue (Iter));
if M = Mode_All then
Executed := False;
end if;
Feuille.Liste_Instr.Forward (Iter);
end loop;
end Execute_Liste;
procedure Execute_Liste (Liste : Feuille.Liste_Instr_Locale.List;
M : Mode;
Ok : in out Boolean) is
Iter : Feuille.Liste_Instr_Locale.Listiter;
Instr : Feuille.Instr_Locale;
Executed : Boolean := False;
begin
Iter := Feuille.Liste_Instr_Locale.Makelistiter (Liste);
while (Feuille.Liste_Instr_Locale.More (Iter) and not Executed) loop
Instr := Feuille.Liste_Instr_Locale.Cellvalue (Iter);
if Bounded_String.Image (Instr.Piece) =
Bounded_String.Image (Struct_Component.Liste_Structure.Cellvalue
(Pieces.Piece_Courante).Name) then
Execute_Liste (Instr.Liste, Mode_All, Ok);
else
Feuille.Liste_Instr_Locale.Forward (Iter);
end if;
end loop;
end Execute_Liste;
function Execute_Instr (Atree : Feuille.Pcell) return Boolean is
begin
return True;
end Execute_Instr;
-- evalue une instruction
procedure Evalue (Tree : in Pcell; Success : in out Boolean) is
Iteratt : Struct_Component.Liste_Attribut.Listiter;
Attrib : Struct_Component.Attribut;
Iterstruc : Struct_Component.Liste_Structure.Listiter;
Struc : Struct_Component.Structure;
Ok : Boolean := True;
A_Bool : Boolean := True;
N_Nbr : Natural := 0;
A_Str : String_Table.I_String;
use Feuille;
use Int_Lib;
begin
case Tree.Kind is
when Egal =>
Success := False;
Consulte (Tree.Left, Iteratt, Ok);
if not Ok then
raise Illegal_Test;
else
Attrib := Struct_Component.Liste_Attribut.Cellvalue
(Iteratt);
Consulte (Tree.Right, Iterstruc, Ok);
if Ok then
Struc := Struct_Component.Liste_Structure.Cellvalue
(Itersrtuc);
if Bounded_String.Image
(Struct_Component.Get_Value (Attrib)) =
Bounded_String.Image (Struc.Name) then
Success := True;
else
Success := False;
end if;
else
Consulte (Tree.Right, A_Bool, Ok);
if Ok then
if Struct_Component.Get_Value (Attrib) = A_Bool then
Success := True;
else
Success := False;
end if;
else
Consulte (Tree.Right, A_Nbr, Ok);
if Ok then
if Struct_Component.Get_Value (Attrib) =
A_Nbr then
Success := True;
else
Success := False;
end if;
else
Consulte (Tree.Right, A_Str, Ok);
if Ok then
if Bounded_String.Image
(Struct_Component.Get_Value
(Attrib)) =
Bounded_String.Image (A_Str) then
Success := True;
else
Success := False;
end if;
else
raise Illegal_Test;
end if;
end if;
end if;
end if;
end if;
when Et =>
Evalue (Tree.Left, Ok);
if Ok then
Evalue (Tree.Left, Ok);
if Ok then
Success := True;
else
Success := False;
end if;
else
Success := False;
end if;
when Verbe =>
if Find (Actions.Table, Tree.Idattrib) =
Interpretor_Result (1).Index then
if ((Tree.Left = null) and
(Interpretor.Result (2).Token = T_End)) then
Success := True;
else
if Tree.Left /= null then
if Interpretor_Result (2).Token = T_Objet then
if Find (Objets.Table, Tree.Left.Idattrib) =
Interpretor_Result (2).Index then
if ((Tree.Left.Left = null) and
(Interpretor.Result (3).Token =
T_End)) then
Success := True;
else
if Tree.Left.Left /= null then
if Find (Objets.Table,
Tree.Left.Left.Idattrib) =
Interpretor_Result (3).Index then
Success := True;
else
Success := False;
end if;
else
Success := False;
end if;
end if;
else
Success := False;
end if;
else
if Interpretor_Result (2).Token =
T_Direction then
if Find (Directions.Table,
Tree.Left.Idattrib) =
Interpretor_Result (2).Index then
if ((Tree.Left.Left = null) and
(Interpretor.Result (3).Token =
T_End)) then
Success := True;
else
raise Illegal_Expression;
end if;
else
Success := False;
end if;
else
Success := False;
end if;
end if;
else
Success := False;
end if;
end if;
else
Success := False;
end if;
when Vaut =>
Affecte (Tree, Success);
when Alors =>
Evalue (Tree.Left, Ok);
if Ok then
Execute (Tree.Right);
Success := True;
else
Success := False;
end if;
when Feuille.Dire =>
if Atree.Right.Kind = Feuille.Chaine then
Text_Io.Put_Line (Bounded_String.Image
(Atree.Right.Phrase));
Success := True;
elsif Atree.Right.Kind = Feuille.Iter then
Text_Io.Put_Line (Bounded_String.Image
(Struct_Component.
Liste_Attribut.Cellvalue
(Atree.Right.Aiter).
Data.The_String));
Success := True;
else
raise Dire_Error;
end if;
when Feuille.Termine =>
Text_Io.Put_Line ("Le jeu est termine.");
Success := True;
raise Jeu_Termine;
when others =>
raise Illegal_Expression;
end case;
end Evalue;
--- affecte un vaut
procedure Affecte (Tree : in Pcell; Success : in out Boolean) is
Iteratt : Struct_Component.Liste_Attribut.Listiter;
Attrib : Struct_Component.Attribut;
Iteratt2 : Struct_Component.Liste_Attribut.Listiter;
Attrib2 : Struct_Component.Attribut;
Iterstruc : Struct_Component.Liste_Structure.Listiter;
Struc : Struct_Component.Structure;
Ok : Boolean;
A_Bool : Boolean;
N_Nbr : Natural;
A_Str : String_Table.I_String;
use Feuille;
begin
Consulte (Tree.Left, Iteratt, Ok);
if Ok then
Attrib := Struct_Component.Get_Value (Iteratt);
Consulte (Tree.Right, Iteratt2, Ok);
if Ok then
Struct_Component.Liste_Attribut.Modify
(Iteratt, Struct_Component.Get_Value (Iteratt2));
Success := True;
else
Consulte (Tree.Right, Iterstruc, Ok);
if Ok then
Struct_Component.Set_Value
(Attrib, Struct_Component.Get_Name (Iterstruc));
Struct_Component.Modify (Iteratt, Attrib);
Success := True;
else
Consulte (Tree.Right, A_Bool, Ok);
if Ok then
Struct_Component.Set_Value (Attrib, A_Bool);
Struct_Component.Modify (Iteratt, Attrib);
Success := True;
else
Consulte (Tree.Right, A_Nbr, Ok);
if Ok then
Struct_Component.Set_Value (Attrib, A_Nbr);
Struct_Component.Modify (Iteratt, Attrib);
Success := True;
else
Consulte (Tree.Right, A_Str, Ok);
if Ok then
if Tree.Right.Kind = Enum then
if String_Table.Int_List.Isinside
(Attrib.Data.List_Of_Enum, A_Str) then
Struct_Component.Set_Value
(Attrib, A_Str);
Struct_Component.Liste_Attribut.Modify
(Iteratt, Attrib);
Success := True;
else
raise Illegal_Assignement;
end if;
else
Struct_Component.Set_Value (Attrib, A_Str);
Struct_Component.Liste_Attribut.Modify
(Iteratt, Attrib);
Success := True;
end if;
else
Consulte (Tree.Right, Oper, Nbr, Ok);
if Ok then
Success := True;
case Oper is
when Plus =>
Struct_Component.Set_Value
(Attrib,
Struct_Component.Get_Value
(Attrib) + Nbr);
when Moins =>
Struct_Component.Set_Value
(Attrib,
Struct_Component.Get_Value
(Attrib) - Nbr);
when Fois =>
Struct_Component.Set_Value
(Attrib,
Struct_Component.Get_Value
(Attrib) * Nbr);
when Div =>
Struct_Component.Set_Value
(Attrib,
Struct_Component.Get_Value
(Attrib) / Nbr);
when others =>
Success := False;
end case;
if Success then
Struct_Component.Liste_Attribut.Modify
(Iteratt, Attrib);
else
raise Illegal_Operator;
end if;
else
raise Illegal_Assignement;
end if;
end if;
end if;
end if;
end if;
end if;
else
Consulte (Tree.Left, Iterstruc, Ok);
if Ok then
if Tree.Left.Kind = Piece_Courante then
Consulte (Tree.Left, Iterstruc2, Ok);
if Ok then
Struct_Component.Is_Inside
(Bounded_String.Image
(Struct_Component.Get_Name (Iterstruct2)),
Pieces.Liste, Piece.Piece_Courante, Ok);
if Ok then
Success := True;
else
raise Illegal_Assignement;
end if;
else
Consulte (Tree.Left, Iteratt, Ok);
if Ok then
Struct_Component.Is_Inside
(Bounded_String.Image
(Struct_Component.Get_Value (Iteratt)),
Pieces.Liste, Piece.Piece_Courante, Ok);
if Ok then
Success := True;
else
raise Illegal_Assignement;
end if;
else
raise Illegal_Assignement;
end if;
end if;
else
raise Illegal_Assignement;
end if;
else
raise Illegal_Assignement;
end if;
end if;
end Affecte;
--- retourne element ( iterateur sur un attribut)
procedure Consulte
(Tree : in Pcell;
Iteratt : in out Struct_Component.Liste_Attribut.Listiter;
Success : in out Boolean) is
Tmp_String : String_Table.I_String;
use Feuille;
begin
if Tree.Kind /= Iter then
if Bounded_String.Image (Tree.Idattrib) = "" then
Success := False;
else
case Tree.Kind is
when Objet | Hero | Pnj | Piece_Courante =>
Bounded_String.Copy (Tmp_String, Tree.Idattrib);
case Tree.Kind is
when Piece_Courante =>
Struct_Component.Is_Inside
(Bounded_String.Image (Tmp_String),
Struct_Component.Liste_Attribut.Cellvalue
(Pieces.Piece_Courante).Attribut,
Iterattrib, Success);
when Hero =>
Struct_Component.Is_Inside
(Bounded_String.Image (Tmp_String),
Struct_Component.Liste_Attribut.Cellvalue
(Pnjs.Hero).Attribut,
Iterattrib, Success);
when Objet =>
Struct_Component.Is_Inside
(Bounded_String.Image (Tmp_String),
Struct_Component.Liste_Attribut.Cellvalue
(Objets.Objet_Courant).Attribut,
Iterattrib, Success);
when Pnj =>
Struct_Component.Is_Inside
(Bounded_String.Image (Tmp_String),
Struct_Component.Liste_Attribut.Cellvalue
(Pnjs.Pnj_Courant).Attribut,
Iterattrib, Success);
when others =>
Success := False;
end case;
when others =>
Success := False;
end case;
end if;
else
Iteratt := Tree.Aiter;
Success := True;
end if;
end Consulte;
--- retourne element_Global ou ident
procedure Consulte
(Tree : in Pcell;
Iterstruc : in out Struct_Component.Liste_Structure.Listiter;
Success : in out Boolean) is
use Feuille;
begin
Success := True;
if Tree.Kind = Iter_S then
Iterstruc := Tree.Aiter_S;
else
case Tree.Kind is
when Piece_Courante =>
Iterstruc := Pieces.Piece_Courante;
when Hero =>
Iterstruc := Pnjs.Hero;
when Pnj =>
Iterstruc := Pnjs.Pnjs_Courant;
when Objet =>
Iterstruc := Objets.Objet_Courant;
--when Direction =>
-- Iterstruc := Directions.Direction_Courante;
when others =>
Success := False;
end case;
end if;
end Consulte;
--- retourne un booleen
procedure Consulte (Tree : Pcell;
A_Bool : in out Boolean;
Success : in out Boolean) is
use Feuille;
begin
if Tree.Kind = Bool then
A_Bool := Tree.Booleen;
Success := True;
else
Success := False;
end if;
end Consulte;
--- retourne un entier
procedure Consulte (Tree : Pcell;
A_Nbr : in out Natural;
Success : in out Boolean) is
use Feuille;
begin
if Tree.Kind = Number then
A_Nbr := Tree.Nbr;
Success := True;
else
Success := False;
end if;
end Consulte;
--- retourne une chaine ou un enum
procedure Consulte (Tree : Pcell;
A_Str : in out String_Table.I_String;
Success : in out Boolean) is
use Feuille;
begin
if ((Tree.Kind = Chaine) or (Tree.Kind = Enum)) then
A_Str := Tree.Idattrib;
Success := True;
else
Success := False;
end if;
end Consulte;
--- retourne operateur plus valeur
procedure Consulte (Tree : in Pcell;
Op : in out Tcell;
Nbr : in out Natural;
Success : in out Boolean) is
use Feuille;
begin
case Tree.Kind is
when Plus | Moins | Fois | Div =>
Consulte (Tree.Right, Nbr, Success);
if Success then
Op := Tree.Kind;
end if;
when others =>
Success := False;
end case;
end Consulte;
end Motor;
nblk1=1d
nid=4
hdr6=36
[0x00] rec0=1b rec1=00 rec2=01 rec3=092
[0x01] rec0=01 rec1=00 rec2=10 rec3=03c
[0x02] rec0=16 rec1=00 rec2=1b rec3=046
[0x03] rec0=1f rec1=00 rec2=12 rec3=030
[0x04] rec0=00 rec1=00 rec2=0e rec3=02a
[0x05] rec0=14 rec1=00 rec2=1d rec3=030
[0x06] rec0=13 rec1=00 rec2=11 rec3=042
[0x07] rec0=1b rec1=00 rec2=09 rec3=008
[0x08] rec0=10 rec1=00 rec2=02 rec3=038
[0x09] rec0=12 rec1=00 rec2=0f rec3=050
[0x0a] rec0=1a rec1=00 rec2=06 rec3=044
[0x0b] rec0=17 rec1=00 rec2=1a rec3=006
[0x0c] rec0=1a rec1=00 rec2=19 rec3=06a
[0x0d] rec0=01 rec1=00 rec2=13 rec3=030
[0x0e] rec0=14 rec1=00 rec2=18 rec3=046
[0x0f] rec0=11 rec1=00 rec2=17 rec3=046
[0x10] rec0=11 rec1=00 rec2=15 rec3=050
[0x11] rec0=10 rec1=00 rec2=0c rec3=02c
[0x12] rec0=16 rec1=00 rec2=0b rec3=02a
[0x13] rec0=15 rec1=00 rec2=16 rec3=028
[0x14] rec0=1b rec1=00 rec2=14 rec3=036
[0x15] rec0=0f rec1=00 rec2=0d rec3=06e
[0x16] rec0=18 rec1=00 rec2=08 rec3=07a
[0x17] rec0=1c rec1=00 rec2=07 rec3=054
[0x18] rec0=00 rec1=00 rec2=1c rec3=014
[0x19] rec0=23 rec1=00 rec2=03 rec3=024
[0x1a] rec0=18 rec1=00 rec2=05 rec3=000
[0x1b] rec0=00 rec1=00 rec2=00 rec3=000
[0x1c] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x2174c216e86585c659a98 0x42a00088462060003
Free Block Chain:
0x4: 0000 00 0a 03 fc 80 11 20 77 68 65 6e 20 50 65 72 73 ┆ when Pers┆
0xa: 0000 00 00 00 b6 80 12 20 63 61 73 65 20 54 72 65 65 ┆ case Tree┆