|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 54707 (0xd5b3)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
with Pile_Controle;
with Reprise_Arriere;
use Reprise_Arriere;
with Flot_Controle;
with Moteur;
package body Calcul is
procedure Parse_Error (Afile : Text_Io.File_Type) is
Error : exception;
begin
Text_Io.Put_Line (" Error .. ");
raise Error;
end Parse_Error;
procedure Dupliquer_Station_Dans_Param (Nom_Station : Les_Types.Ptr_String;
J : Natural;
Ok : in out Boolean) is
Val_Param : Table_Symbole.Pobject;
Object_Station_Transmis_En_Param : Table_Symbole.Pobject;
Object_Station : Table_Symbole.Pobject; -- la copie de la station
Nom_T1 : Les_Types.Ptr_String;
begin
Table_Symbole.Rechercher (Nom_Station,
Object_Station_Transmis_En_Param, Ok);
if Ok then
null;
else
Pile_Controle.B.Recherche_Si_Parametre_De
(null, Nom_Station, Object_Station_Transmis_En_Param, Ok);
end if;
Pile_Controle.A.Lire_Parametre_De (null, J, Val_Param, Ok);
Object_Station := new Object (Structure);
Object_Station.Nom := new String'(Val_Param.Nom.all);
Object_Station.Le_Type := Structure;
Object_Station.Addresse := Object_Station_Transmis_En_Param.Addresse;
Object_Station.Nombre_Parametre :=
Object_Station_Transmis_En_Param.Nombre_Parametre;
for I in 1 .. Object_Station_Transmis_En_Param.Nombre_Parametre loop
Object_Station.Parametre (I) :=
new Object
(Object_Station_Transmis_En_Param.Parametre (I).Le_Type);
Object_Station.Parametre (I).Nom :=
new String'
(Object_Station_Transmis_En_Param.Parametre (I).Nom.all);
Object_Station.Parametre (I).Le_Type :=
Object_Station_Transmis_En_Param.Parametre (I).Le_Type;
Object_Station.Parametre (I).Addresse :=
Object_Station_Transmis_En_Param.Parametre (I).Addresse;
end loop;
Object_Station.L_Arbre_Abstrait :=
Object_Station_Transmis_En_Param.L_Arbre_Abstrait;
Pile_Controle.A.Modifier_Parametre_De (null, J, Object_Station, Ok);
end Dupliquer_Station_Dans_Param;
function Parse_Passage_Parametres
(Afile : Text_Io.File_Type;
Atime : Duration;
Nom_Ssprg : Les_Types.Ptr_String) return Boolean is
Nom_Param, Nom_T1 : Les_Types.Ptr_String;
Ok : Boolean := True;
I : Natural := 1;
Val_Param : Table_Symbole.Pobject;
Valeur_Variable : Float;
Ptr1, Ptr2 : L_Arbre_Abstrait.Pnoeud;
function Parse_Descript_Parametre
(Afile : Text_Io.File_Type; Atime : Duration)
return Boolean;
procedure Parse_Liste (Afile : Text_Io.File_Type;
Ok : in out Boolean;
Atime : Duration) is
begin
if Lex_Get_Token = L_Virg then
Lex_Next_Token (Afile);
if Parse_Descript_Parametre (Afile, Atime) then
if (Lex_Get_Token = L_Virg and I < 10) then
Lex_Next_Token (Afile);
Parse_Liste (Afile, Ok, Atime);
else
null;
end if;
else
Ok := False;
end if;
else
Ok := False;
end if;
end Parse_Liste;
function Parse_Descript_Parametre
(Afile : Text_Io.File_Type; Atime : Duration)
return Boolean is
begin
case Lex_Get_Token is
when L_Reg =>
Nom_Param := new String'(Lex_Get_Value.all);
Object_Inconnu := new Table_Symbole.Object;
Table_Symbole.Rechercher (Nom_Param, Object_Inconnu, Ok);
if Ok then
case Object_Inconnu.Le_Type is
when Registre =>
Val_Param := new
Table_Symbole.Object (Registre);
Parse_Expr (Ok, Valeur_Variable, Afile, Atime);
Table_Symbole.Lire_Parametre_De
(Nom_Ssprg, I, Val_Param, Ok);
Val_Param.Valeur := Valeur_Variable;
Table_Symbole.Modifier_Parametre_De
(Nom_Ssprg, I, Val_Param, Ok);
when Structure =>
Dupliquer_Station_Dans_Param (Nom_Param, I, Ok);
Lex_Next_Token (Afile);
when Effet =>
Parse_Expr (Ok, Valeur_Variable, Afile, Atime);
Pile_Controle.A.Lire_Parametre_De
(Nom_Ssprg, I, Val_Param, Ok);
Val_Param.Valeur := Valeur_Variable;
Pile_Controle.A.Modifier_Parametre_De
(Nom_Ssprg, I, Val_Param, Ok);
when others =>
null;
end case;
else
Addresseur.Depiler (Stacka, Nom_T1);
Table_Symbole.Recherche_Si_Parametre_De
(Nom_T1, Nom_Param, Object_Inconnu, Ok);
Addresseur.Empiler (Stacka, Nom_T1);
if Ok then
case Object_Inconnu.Le_Type is
when Registre =>
Val_Param :=
new Table_Symbole.Object (Registre);
Parse_Expr (Ok, Valeur_Variable,
Afile, Atime);
Pile_Controle.A.Lire_Parametre_De
(Nom_Ssprg, I, Val_Param, Ok);
Val_Param.Valeur := Valeur_Variable;
Pile_Controle.A.Modifier_Parametre_De
(Nom_Ssprg, I, Val_Param, Ok);
when Structure =>
Dupliquer_Station_Dans_Param
(Nom_Param, I, Ok);
Lex_Next_Token (Afile);
when Effet =>
Parse_Expr (Ok, Valeur_Variable,
Afile, Atime);
Pile_Controle.A.Lire_Parametre_De
(Nom_Ssprg, I, Val_Param, Ok);
Val_Param.Valeur := Valeur_Variable;
Pile_Controle.A.Modifier_Parametre_De
(Nom_Ssprg, I, Val_Param, Ok);
when others =>
null;
end case;
end if;
end if;
when L_Digit =>
Val_Param := new Table_Symbole.Object (Registre);
Parse_Expr (Ok, Valeur_Variable, Afile, Atime);
Pile_Controle.A.Lire_Parametre_De
(Nom_Ssprg, I, Val_Param, Ok);
Val_Param.Valeur := Valeur_Variable;
Pile_Controle.A.Modifier_Parametre_De
(Nom_Ssprg, I, Val_Param, Ok);
when others =>
Ok := False;
end case;
return Ok;
end Parse_Descript_Parametre;
begin
Ptr1 := L_Arbre_Abstrait.Creer_Feuille (Vide, null);
if Lex_Get_Token = L_Open then
Lex_Next_Token (Afile);
while (Lex_Get_Token /= L_Close) loop
if (Parse_Descript_Parametre (Afile, Atime)) then
null;
else
Ok := False;
end if;
Ptr1 := Ptr2;
I := I + 1;
if Lex_Get_Token /= L_Close then
Lex_Next_Token (Afile);
end if;
end loop;
Lex_Next_Token (Afile);
else
Ok := False;
end if;
return Ok;
end Parse_Passage_Parametres;
function Adresse_Vers_Chaine (A : Natural) return Les_Types.Ptr_String is
P : Les_Types.Ptr_String;
begin
if 0 <= A and A <= 9 then
P := new String'("0" & Natural'Image (A) (2 .. 2));
else
P := new String'(Natural'Image (A) (2 .. 3));
end if;
return P;
end Adresse_Vers_Chaine;
function Valeur_Vers_Chaine (A : Natural) return Les_Types.Ptr_String is
P : Les_Types.Ptr_String;
begin
if 0 <= A and A <= 9 then
P := new String'("000" & Natural'Image (A) (2 .. 2));
else
if 10 <= A and A <= 99 then
P := new String'("00" & Natural'Image (A) (2 .. 3));
else
if 100 <= A and A <= 999 then
P := new String'("0" & Natural'Image (A) (2 .. 4));
else
if 1000 <= A and A <= 9999 then
P := new String'(Natural'Image (A) (2 .. 5));
end if;
end if;
end if;
end if;
return P;
end Valeur_Vers_Chaine;
procedure Modifie_Valeur_Acteur_Affiche_Trame
(Atime : Duration;
Val : in out Table_Symbole.Pobject;
Local : Les_Types.Type_Value) is
La_Trame : Les_Types.Ptr_String;
begin
case Val.Le_Type is
when Binaire =>
if Float (Local) > 0.0 then
Val.Valeurb := True;
La_Trame :=
new String'
("D" &
Adresse_Vers_Chaine (Object_Inconnu.Addresse).
all &
Adresse_Vers_Chaine (Val.Addresse).all &
Valeur_Vers_Chaine (1).all &
"F");
else
Val.Valeurb := False;
La_Trame :=
new String'
("D" &
Adresse_Vers_Chaine (Object_Inconnu.Addresse).
all &
Adresse_Vers_Chaine (Val.Addresse).all &
Valeur_Vers_Chaine (0).all &
"F");
end if;
when Discret =>
Val.Valeurd := Natural (Local);
La_Trame :=
new String'
("D" &
Adresse_Vers_Chaine (Object_Inconnu.Addresse).all &
Adresse_Vers_Chaine (Val.Addresse).all &
Valeur_Vers_Chaine (Val.Valeurd).all &
"F");
when Fugitif =>
Val.Valeurf := Natural (Local);
La_Trame :=
new String'
("D" &
Adresse_Vers_Chaine (Object_Inconnu.Addresse).all &
Adresse_Vers_Chaine (Val.Addresse).all &
Valeur_Vers_Chaine (Val.Valeurf).all &
"F");
when Temporel =>
Val.Valeurt := Natural (Local);
La_Trame :=
new String'
("D" &
Adresse_Vers_Chaine (Object_Inconnu.Addresse).all &
Adresse_Vers_Chaine (Val.Addresse).all &
Valeur_Vers_Chaine (Val.Valeurt).all &
"F");
when others =>
null;
end case;
Moteur.Ajoute_Trame_Dans_Tableau (Atime, La_Trame);
end Modifie_Valeur_Acteur_Affiche_Trame;
procedure Modifie_Valeur_Acteur_Affiche_Trame
(Atime : Duration;
Val : in out Table_Symbole.Pobject;
Local, Local1 : Les_Types.Type_Value) is
La_Trame : Les_Types.Ptr_String;
begin
case Val.Le_Type is
when Binaire =>
if Float (Local) > 0.0 then
Val.Valeurb := True;
La_Trame :=
new String'
("D" &
Adresse_Vers_Chaine (Object_Inconnu.Addresse).
all &
Adresse_Vers_Chaine (Val.Addresse).all &
Valeur_Vers_Chaine (1).all &
"F");
else
Val.Valeurb := False;
La_Trame :=
new String'
("D" &
Adresse_Vers_Chaine (Object_Inconnu.Addresse).
all &
Adresse_Vers_Chaine (Val.Addresse).all &
Valeur_Vers_Chaine (0).all &
"F");
end if;
when Discret =>
Val.Valeurd := Natural (Local);
La_Trame :=
new String'
("D" &
Adresse_Vers_Chaine (Object_Inconnu.Addresse).all &
Adresse_Vers_Chaine (Val.Addresse).all &
Valeur_Vers_Chaine (Val.Valeurd).all &
Valeur_Vers_Chaine (Natural (Local1)).all &
"F");
when Fugitif =>
Val.Valeurf := Natural (Local);
La_Trame :=
new String'
("D" &
Adresse_Vers_Chaine (Object_Inconnu.Addresse).all &
Adresse_Vers_Chaine (Val.Addresse).all &
Valeur_Vers_Chaine (Val.Valeurf).all &
Valeur_Vers_Chaine (Natural (Local1)).all &
"F");
when Temporel =>
Val.Valeurt := Natural (Local);
La_Trame :=
new String'
("D" &
Adresse_Vers_Chaine (Object_Inconnu.Addresse).all &
Adresse_Vers_Chaine (Val.Addresse).all &
Valeur_Vers_Chaine (Val.Valeurt).all &
Valeur_Vers_Chaine (Natural (Local1)).all &
"F");
when others =>
null;
end case;
Moteur.Ajoute_Trame_Dans_Tableau (Atime, La_Trame);
Text_Io.Put_Line (" Trame Evol");
end Modifie_Valeur_Acteur_Affiche_Trame;
procedure Modifie_L_Acteur_De_Station
(Atime : Duration;
Local : Les_Types.Type_Value;
L_Acteur : Les_Types.Ptr_String;
Object_Station : Table_Symbole.Pobject) is
I : Natural := 1;
Trouve : Boolean := False;
begin
if Object_Station.Le_Type = Structure then
while (I <= Object_Station.Nombre_Parametre) and (not Trouve) loop
if L_Acteur.all = Object_Station.Parametre (I).Nom.all then
Trouve := True;
Modifie_Valeur_Acteur_Affiche_Trame
(Atime, Object_Station.Parametre (I), Local);
end if;
I := I + 1;
end loop;
end if;
end Modifie_L_Acteur_De_Station;
procedure Modifie_L_Acteur_De_Station
(Atime : Duration;
Local, Local1 : Les_Types.Type_Value;
L_Acteur : Les_Types.Ptr_String;
Object_Station : Table_Symbole.Pobject) is
I : Natural := 1;
Trouve : Boolean := False;
begin
if Object_Station.Le_Type = Structure then
while (I <= Object_Station.Nombre_Parametre) and (not Trouve) loop
if L_Acteur.all = Object_Station.Parametre (I).Nom.all then
Trouve := True;
Modifie_Valeur_Acteur_Affiche_Trame
(Atime, Object_Station.Parametre (I), Local, Local1);
end if;
I := I + 1;
end loop;
end if;
end Modifie_L_Acteur_De_Station;
function Parse_Actions_Preenregistrees
(Afile : Text_Io.File_Type; Atime : Duration) return Boolean is
La_Station, L_Acteur, Nom_T1 : Les_Types.Ptr_String;
Local, Local1 : Les_Types.Type_Value;
Ok1 : Boolean;
Bool, Val : Table_Symbole.Pobject;
Ptr1, Ptr2, Ptr3 : Arbre_Abstrait_Types.L_Arbre_Abstrait.Pnoeud;
begin
Ok1 := True;
case Lex_Get_Token is
when L_Activer =>
Lex_Next_Token (Afile);
if Lex_Get_Token = L_Open then
Lex_Next_Token (Afile);
if Lex_Get_Token = L_Reg then
La_Station := new String'(Lex_Get_Value.all);
Lex_Next_Token (Afile);
if Lex_Get_Token = L_Virg then
Lex_Next_Token (Afile);
if Lex_Get_Token = L_Reg then
L_Acteur := new String'(Lex_Get_Value.all);
Table_Symbole.Lire_Parametre_De
(La_Station, L_Acteur, Val, Ok1);
Val.Valeurb := True;
Table_Symbole.Modifier_Parametre_De
(La_Station, L_Acteur, Val, Ok1);
if Ok1 then
null;
else
Ok1 := True;
end if;
Lex_Next_Token (Afile);
if Lex_Get_Token = L_Close then
null;
else
Parse_Error (Afile);
end if;
else
Parse_Error (Afile);
end if;
else
Parse_Error (Afile);
end if;
else
Parse_Error (Afile);
end if;
else
Parse_Error (Afile);
end if;
when L_Changer =>
Lex_Next_Token (Afile);
if Lex_Get_Token = L_Open then
Lex_Next_Token (Afile);
if Lex_Get_Token = L_Reg then
La_Station := new String'(Lex_Get_Value.all);
Lex_Next_Token (Afile);
if Lex_Get_Token = L_Virg then
Lex_Next_Token (Afile);
if Lex_Get_Token = L_Reg then
Lex_Next_Token (Afile);
L_Acteur := new String'(Lex_Get_Value.all);
Object_Inconnu := new Table_Symbole.Object;
Table_Symbole.Rechercher
(La_Station, Object_Inconnu, Ok1);
if Ok1 then
null;
if Lex_Get_Token = L_Virg then
Lex_Next_Token (Afile);
Parse_Expr (Ok1, Local, Afile, Atime);
if Ok1 then
null;
if Ok1 then
Table_Symbole.Rechercher (La_Station, Object_Inconnu, Ok1);
Table_Symbole.Lire_Parametre_De
(La_Station, L_Acteur, Val, Ok1);
Modifie_Valeur_Acteur_Affiche_Trame (Atime, Val, Local);
Table_Symbole.Modifier_Parametre_De
(La_Station, L_Acteur, Val, Ok1);
if Lex_Get_Token = L_Close then
null;
else
Parse_Error (Afile);
end if;
else
Parse_Error (Afile);
end if;
else
Parse_Error (Afile);
end if;
else
Parse_Error (Afile);
end if;
else
Addresseur.Depiler (Stacka, Nom_T1);
Table_Symbole.Recherche_Si_Parametre_De
(Nom_T1, La_Station,
Object_Inconnu, Ok1);
Addresseur.Empiler (Stacka, Nom_T1);
if Ok1 then
Object_Inconnu :=
new Table_Symbole.Object;
Pile_Controle.B.
Recherche_Si_Parametre_De
(Nom_T1, La_Station,
Object_Inconnu, Ok1);
if Ok1 then
if Lex_Get_Token = L_Virg then
Lex_Next_Token (Afile);
Parse_Expr (Ok1, Local, Afile, Atime);
if Lex_Get_Token = L_Close then
null;
else
Parse_Error (Afile);
end if;
else
Parse_Error (Afile);
end if;
Object_Inconnu :=
new Table_Symbole.Object;
Pile_Controle.B.
Recherche_Si_Parametre_De
(Nom_T1, La_Station,
Object_Inconnu, Ok1);
Modifie_L_Acteur_De_Station
(Atime, Local, L_Acteur,
Object_Inconnu);
Pile_Controle.B.
Modifier_Parametre_De
(null, La_Station,
Object_Inconnu, Ok1);
else
Parse_Error (Afile);
end if;
if Ok1 then
case Object_Inconnu.Le_Type is
when Structure =>
null;
when others =>
null;
end case;
end if;
else
Parse_Error (Afile);
end if;
end if;
else
Parse_Error (Afile);
end if;
else
Parse_Error (Afile);
end if;
else
Parse_Error (Afile);
end if;
else
Parse_Error (Afile);
end if;
when L_Evoluer =>
Lex_Next_Token (Afile);
if Lex_Get_Token = L_Open then
Lex_Next_Token (Afile);
if Lex_Get_Token = L_Reg then
La_Station := new String'(Lex_Get_Value.all);
Lex_Next_Token (Afile);
if Lex_Get_Token = L_Virg then
Lex_Next_Token (Afile);
if Lex_Get_Token = L_Reg then
Lex_Next_Token (Afile);
L_Acteur := new String'(Lex_Get_Value.all);
Object_Inconnu := new Table_Symbole.Object;
Table_Symbole.Rechercher
(La_Station, Object_Inconnu, Ok1);
if Ok1 then
null;
if Lex_Get_Token = L_Virg then
Lex_Next_Token (Afile);
Parse_Expr (Ok1, Local, Afile, Atime);
if Ok1 then
if Lex_Get_Token = L_Virg then
Lex_Next_Token (Afile);
Parse_Expr (Ok1, Local1, Afile, Atime);
if Ok1 then
null;
if Ok1 then
Table_Symbole.Rechercher
(La_Station, Object_Inconnu, Ok1);
Table_Symbole.Lire_Parametre_De
(La_Station, L_Acteur, Val, Ok1);
Modifie_Valeur_Acteur_Affiche_Trame
(Atime, Val, Local, Local1);
Table_Symbole.Modifier_Parametre_De
(La_Station, L_Acteur, Val, Ok1);
if Lex_Get_Token = L_Close then
null;
else
Parse_Error (Afile);
end if;
else
Parse_Error (Afile);
end if;
else
Parse_Error (Afile);
end if;
else
Parse_Error (Afile);
end if;
else
Parse_Error (Afile);
end if;
else
Parse_Error (Afile);
end if;
else
Addresseur.Depiler (Stacka, Nom_T1);
Table_Symbole.Recherche_Si_Parametre_De
(Nom_T1, La_Station,
Object_Inconnu, Ok1);
Addresseur.Empiler (Stacka, Nom_T1);
if Ok1 then
Object_Inconnu :=
new Table_Symbole.Object;
Pile_Controle.B.
Recherche_Si_Parametre_De
(Nom_T1, La_Station,
Object_Inconnu, Ok1);
if Ok1 then
if Lex_Get_Token = L_Virg then
Lex_Next_Token (Afile);
Parse_Expr (Ok1, Local, Afile, Atime);
if Lex_Get_Token = L_Virg then
Lex_Next_Token (Afile);
Parse_Expr (Ok1, Local1, Afile, Atime);
if Lex_Get_Token = L_Close then
null;
else
Parse_Error (Afile);
end if;
else
Parse_Error (Afile);
end if;
else
Parse_Error (Afile);
end if;
Object_Inconnu :=
new Table_Symbole.Object;
Pile_Controle.B.
Recherche_Si_Parametre_De
(Nom_T1, La_Station,
Object_Inconnu, Ok1);
Modifie_L_Acteur_De_Station
(Atime, Local, Local1,
L_Acteur, Object_Inconnu);
Pile_Controle.B.
Modifier_Parametre_De
(null, La_Station,
Object_Inconnu, Ok1);
else
Parse_Error (Afile);
end if;
if Ok1 then
case Object_Inconnu.Le_Type is
when Structure =>
null;
when others =>
null;
end case;
end if;
else
Parse_Error (Afile);
end if;
end if;
else
Parse_Error (Afile);
end if;
else
Parse_Error (Afile);
end if;
else
Parse_Error (Afile);
end if;
else
Parse_Error (Afile);
end if;
when others =>
Parse_Error (Afile);
end case;
Lex_Next_Token (Afile);
return True;
end Parse_Actions_Preenregistrees;
function Parse_Inst (Afile : Text_Io.File_Type; Atime : in Duration)
return Boolean is
T1 : Duration;
Local : Type_Value;
Reg, Nom_T1 : Les_Types.Ptr_String;
Element : Table_Symbole.Pobject (Effet);
Etiq_Retour, Etiq_Debut, Etiq_Apres : Natural := 0;
Ok1, Valeur_Boolean : Boolean;
Token_Courant : Token;
I : Integer;
Label_Get1, Label_Get2, Label_Get3 : Natural;
begin
Ok1 := True;
Token_Courant := Lex_Get_Token;
case Token_Courant is
when L_A =>
Lex_Next_Token (Afile);
Parse_Expr (Ok1, Local, Afile, Atime);
T1 := Duration (Local);
if Lex_Get_Token = L_Faire then
Lex_Next_Token (Afile);
if Parse_Inst (Afile, T1 + Atime) then
null;
else
Ok1 := False;
end if;
else
Ok1 := False;
end if;
when L_Debut =>
Lex_Next_Token (Afile);
I := 0;
while (Lex_Get_Token /= L_Fin) loop
if (Parse_Inst (Afile, Atime) = True) then
null;
else
Ok1 := False;
end if;
I := I + 1;
end loop;
Lex_Next_Token (Afile);
when L_Activer =>
Ok1 := Parse_Actions_Preenregistrees (Afile, Atime);
if Lex_Get_Token = L_Separ then
Lex_Next_Token (Afile);
else
null;
end if;
when L_Changer =>
Ok1 := Parse_Actions_Preenregistrees (Afile, Atime);
if Lex_Get_Token = L_Separ then
Lex_Next_Token (Afile);
else
null;
end if;
when L_Evoluer =>
Ok1 := Parse_Actions_Preenregistrees (Afile, Atime);
if Lex_Get_Token = L_Separ then
Lex_Next_Token (Afile);
else
null;
end if;
when L_Reg =>
Reg := new String'(Lex_Get_Value.all);
Lex_Next_Token (Afile);
if Lex_Get_Token = L_Eq then
Lex_Next_Token (Afile);
Parse_Expr (Ok1, Local, Afile, Atime);
if Ok1 then
Object_Inconnu := new Table_Symbole.Object;
Table_Symbole.Rechercher (Reg, Object_Inconnu, Ok1);
if Ok1 then
case Object_Inconnu.Le_Type is
when Registre =>
Pile_Controle.B.Lire_Parametre_De
(Nom_T1, Reg, Object_Inconnu, Ok1);
Object_Inconnu.Valeur := Local;
when others =>
null;
end case;
else
Addresseur.Depiler (Stacka, Nom_T1);
Table_Symbole.Recherche_Si_Parametre_De
(Nom_T1, Reg, Object_Inconnu, Ok1);
Addresseur.Empiler (Stacka, Nom_T1);
if Ok1 then
case Object_Inconnu.Le_Type is
when Registre =>
Pile_Controle.B.Lire_Parametre_De
(Nom_T1, Reg, Object_Inconnu, Ok1);
Object_Inconnu.Valeur := Local;
when others =>
null;
end case;
else
Addresseur.Depiler (Stacka, Nom);
Table_Symbole.Recherche_Si_Parametre_De
(Nom, Reg, Object_Inconnu, Ok1);
Addresseur.Empiler (Stacka, Nom);
if Ok1 then
case Object_Inconnu.Le_Type is
when Registre =>
Object_Inconnu.Valeur := Local;
Table_Symbole.Modifier_Parametre_De
(Nom, Reg, Object_Inconnu, Ok1);
when others =>
null;
end case;
else
Object_Inconnu := new Object (Registre);
Object_Inconnu.Nom := new String'(Reg.all);
Object_Inconnu.Le_Type := Registre;
Object_Inconnu.Valeur := Local;
Table_Symbole.Inserer
(Reg, Object_Inconnu, Ok1);
Object_Inconnu := new Object (Registre);
Object_Inconnu.Valeur := 3.14;
Table_Symbole.Rechercher
(Reg, Object_Inconnu, Ok1);
end if;
end if;
end if;
end if;
end if;
if Lex_Get_Token = L_Separ then -- fin d'instruction
Lex_Next_Token (Afile);
else
Ok1 := False;
end if;
when L_Prt =>
Lex_Next_Token (Afile);
Parse_Expr (Ok1, Local, Afile, Atime);
Token_Courant := Lex_Get_Token;
Text_Io.Put_Line (" => ");
Float_Texte.Put (Local);
if Token_Courant = L_Separ then
Lex_Next_Token (Afile);
else
Ok1 := False;
end if;
when L_Retourne =>
Lex_Next_Token (Afile);
Parse_Expr (Ok1, Local, Afile, Atime);
Object_Inconnu := new Object (Registre);
Pile_Controle.B.Lire_Valeur_Retour_De
(Nom, Object_Inconnu, Ok1);
if Ok1 then
Object_Inconnu.Valeur := Local;
Pile_Controle.B.Modifier_Valeur_Retour_De
(Nom, Object_Inconnu, Ok1);
Pile_Controle.B.Lire_Valeur_Retour_De
(Nom, Object_Inconnu, Ok1);
end if;
Token_Courant := Lex_Get_Token;
if Token_Courant = L_Separ then
Lex_Next_Token (Afile);
else
Ok1 := False;
end if;
when L_Separ =>
Lex_Next_Token (Afile);
when L_Executer =>
Lex_Next_Token (Afile);
Parse_Expr (Ok1, Local, Afile, Atime);
Token_Courant := Lex_Get_Token;
if Token_Courant = L_Separ then
Lex_Next_Token (Afile);
else
Ok1 := False;
end if;
when L_Tant =>
Lex_Next_Token (Afile);
if Lex_Get_Token = L_Que then
Lex_Next_Token (Afile);
Parse_Expr_Bool (Valeur_Boolean, Afile, Atime);
if Valeur_Boolean then
if (Parse_Inst (Afile, Atime) = True) then
null;
else
Ok1 := False;
end if;
Pile_Lex.Prg_Lire_Posi_Iterateur (Label_Get3);
Pile_Lex.Prg_Iterateur_A_Position
(Gen_Read (Label_Get3).Indice - 1);
Lex_Next_Token (Afile);
else
Pile_Lex.Prg_Lire_Posi_Iterateur (Label_Get2);
Pile_Lex.Prg_Iterateur_A_Position
(Gen_Read (Label_Get2).Indice - 1);
Lex_Next_Token (Afile);
end if;
end if;
when L_Si =>
Lex_Next_Token (Afile);
Parse_Expr_Bool (Valeur_Boolean, Afile, Atime);
if Valeur_Boolean then
if Lex_Get_Token = L_Alors then
Lex_Next_Token (Afile);
if (Parse_Inst (Afile, Atime) = True) then
null;
else
Ok1 := False;
end if;
Pile_Lex.Prg_Lire_Posi_Iterateur (Label_Get1);
Pile_Lex.Prg_Iterateur_A_Position
(Gen_Read (Label_Get1).Indice);
Lex_Next_Token (Afile);
end if;
else
Pile_Lex.Prg_Lire_Posi_Iterateur (Label_Get1);
Pile_Lex.Prg_Iterateur_A_Position
(Gen_Read (Label_Get1).Indice - 1);
Lex_Next_Token (Afile);
if (Parse_Inst (Afile, Atime) = True) then
null;
else
Ok1 := False;
end if;
end if;
when others =>
Ok1 := False;
end case;
return Ok1;
end Parse_Inst;
procedure Parse_Fact (Ok : out Boolean;
Value : out Les_Types.Type_Value;
Afile : Text_Io.File_Type;
Atime : Duration) is
Element : Table_Symbole.Pobject (Fonction);
Etiq_Retour, Etiq_Debut, Etiq_Apres : Natural := 0;
Herited, Local : Les_Types.Type_Value;
Reg, Nom_T1, Nom_T2 : Les_Types.Ptr_String;
Ok1, Ok2 : Boolean;
Token_Courant : Token;
begin
Ok1 := True;
Herited := 0.0;
Local := 0.0;
Token_Courant := Lex_Get_Token;
case Token_Courant is
when L_Open =>
Lex_Next_Token (Afile);
Parse_Expr (Ok1, Local, Afile, Atime);
if Ok1 then
Herited := Herited + Local;
if Lex_Get_Token = L_Close then
Lex_Next_Token (Afile);
else
Ok1 := False;
end if;
else
Ok1 := False;
end if;
when L_Sqrt =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile, Atime);
if Ok1 then
Herited := Herited + Sqrt (Local);
else
Ok1 := False;
end if;
when L_Log =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile, Atime);
if Ok1 then
Herited := Herited + Log (Local);
else
Ok1 := False;
end if;
when L_Exp =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile, Atime);
if Ok1 then
Herited := Herited + Exp (Local);
else
Ok1 := False;
end if;
when L_Sin =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile, Atime);
if Ok1 then
Herited := Herited + Sin (Local);
else
Ok1 := False;
end if;
when L_Cos =>
Lex_Next_Token (Afile);
Parse_Fact (Ok, Local, Afile, Atime);
if Ok1 then
Herited := Herited + Cos (Local);
else
Ok1 := False;
end if;
when L_Arctan =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile, Atime);
if Ok1 then
Herited := Herited + Arctan (Local);
else
Ok1 := False;
end if;
when L_Reg =>
Reg := new String'(Lex_Get_Value.all);
Object_Inconnu := new Table_Symbole.Object;
Table_Symbole.Rechercher (Reg, Object_Inconnu, Ok1);
if Ok1 then
case Object_Inconnu.Le_Type is
when Les_Types.Registre =>
Local := Object_Inconnu.Valeur;
when Les_Types.Effet =>
Pile_Controle.A.Empiler (Reg, Ok1);
Etiq_Debut := Object_Inconnu.Etiquette;
Lex_Next_Token (Afile);
if (Parse_Passage_Parametres
(Afile, Atime, Reg)) then
null;
end if;
Pile_Controle.Depile_De_A_Empile_Sur_B;
Addresseur.Empiler (Stacka, Reg);
Pile_Lex.Prg_Lire_Posi_Iterateur (Etiq_Retour);
Pile_Entiers.Empiler (Stack, Etiq_Retour);
Pile_Lex.Prg_Iterateur_A_Position (Etiq_Debut);
Lex_Next_Token (Afile);
if (Parse_Inst (Afile, Atime) = True) then
null;
else
Ok1 := False;
end if;
Object_Inconnu := null;
Object_Inconnu :=
new Table_Symbole.Object (Registre);
Pile_Controle.B.Lire_Valeur_Retour_De
(Reg, Object_Inconnu, Ok1);
Local := Object_Inconnu.Valeur;
Pile_Controle.B.Depiler;
Addresseur.Depiler (Stacka, Reg);
Pile_Entiers.Depiler (Stack, Etiq_Retour);
Pile_Lex.Prg_Iterateur_A_Position (Etiq_Retour - 1);
when others =>
null;
end case;
else
Addresseur.Depiler (Stacka, Nom_T1);
Table_Symbole.Recherche_Si_Parametre_De
(Nom_T1, Reg, Object_Inconnu, Ok1);
Addresseur.Empiler (Stacka, Nom_T1);
if Ok1 then
case Object_Inconnu.Le_Type is
when Les_Types.Registre =>
Pile_Controle.B.Lire_Parametre_De
(Nom_T1, Reg, Object_Inconnu, Ok1);
Local := Object_Inconnu.Valeur;
when others =>
null;
end case;
else
Addresseur.Depiler (Stacka, Nom_T1);
Addresseur.Depiler (Stacka, Nom_T2);
Table_Symbole.Recherche_Si_Parametre_De
(Nom_T2, Reg, Object_Inconnu, Ok1);
Addresseur.Empiler (Stacka, Nom_T2);
Addresseur.Empiler (Stacka, Nom_T1);
if Ok1 then
case Object_Inconnu.Le_Type is
when Les_Types.Registre =>
Pile_Controle.B.Lire_Parametre_De
(Nom_T1, Reg, Object_Inconnu, Ok1);
Local := Object_Inconnu.Valeur;
when others =>
null;
end case;
end if;
end if;
end if;
Herited := Local + Herited;
Lex_Next_Token (Afile);
when L_Digit =>
Local := Lex_Get_Value_Float;
Herited := Local;
Lex_Next_Token (Afile);
when others =>
Ok1 := False;
end case;
Value := Herited;
Ok := Ok1;
end Parse_Fact;
procedure Parse_Term (Ok : out Boolean;
Value : out Les_Types.Type_Value;
Afile : Text_Io.File_Type;
Atime : Duration) is
Herited, Local : Les_Types.Type_Value;
Reg : Les_Types.Ptr_String;
Ok1 : Boolean;
Token_Courant : Token;
begin
Ok1 := True;
Parse_Fact (Ok1, Local, Afile, Atime);
if Ok1 then
Herited := Local;
Token_Courant := Lex_Get_Token;
while ((Lex_Get_Token = L_Star or Lex_Get_Token = L_Div or
Lex_Get_Token = L_Mod) and Ok1) loop
case Lex_Get_Token is
when L_Star =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile, Atime);
if Ok1 then
Herited := Herited * Local;
else
Ok1 := False;
end if;
when L_Div =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile, Atime);
if Ok1 then
Herited := Herited / Local;
else
Ok1 := False;
end if;
when L_Mod =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile, Atime);
if Ok1 then
Herited := Herited;
else
Ok1 := False;
end if;
when others =>
null;
end case;
Token_Courant := Lex_Get_Token;
end loop;
else
Ok1 := False;
end if;
Value := Herited;
Ok := Ok1;
end Parse_Term;
procedure Parse_Expr (Ok : out Boolean;
Value : out Les_Types.Type_Value;
Afile : Text_Io.File_Type;
Atime : Duration) is
Herited, Local : Les_Types.Type_Value;
Ok1 : Boolean;
Token_Courant : Token;
begin
Ok1 := True;
Parse_Term (Ok1, Local, Afile, Atime);
if Ok1 then
Herited := Local;
Token_Courant := Lex_Get_Token;
while ((Lex_Get_Token = L_Plus or Lex_Get_Token = L_Moins) and
Ok1) loop
case Lex_Get_Token is
when L_Plus =>
Lex_Next_Token (Afile);
Parse_Term (Ok1, Local, Afile, Atime);
if Ok1 then
Herited := Herited + Local;
else
Ok1 := False;
end if;
when L_Moins =>
Lex_Next_Token (Afile);
Parse_Term (Ok1, Local, Afile, Atime);
if Ok1 then
Herited := Herited - Local;
else
Ok1 := False;
end if;
when others =>
null;
end case;
end loop;
else
Ok1 := False;
end if;
Value := Herited;
Ok := Ok1;
end Parse_Expr;
procedure Parse_Expr_Bool (Val_Boolean : in out Boolean;
Afile : Text_Io.File_Type;
Atime : Duration) is
Local, Local1 : Les_Types.Type_Value;
Ok1 : Boolean := True;
begin
Parse_Expr (Ok1, Local, Afile, Atime);
if Ok1 then
case Lex_Get_Token is
when L_Lt =>
Lex_Next_Token (Afile);
Parse_Expr (Ok1, Local1, Afile, Atime);
if not Ok1 then
Ok1 := False;
end if;
if (Local < Local1) then
Val_Boolean := True;
else
Val_Boolean := False;
end if;
when L_Gt =>
Lex_Next_Token (Afile);
Parse_Expr (Ok1, Local1, Afile, Atime);
if not Ok1 then
Ok1 := False;
end if;
if (Local > Local1) then
Val_Boolean := True;
else
Val_Boolean := False;
end if;
when L_Geq =>
Lex_Next_Token (Afile);
Parse_Expr (Ok1, Local1, Afile, Atime);
if not Ok1 then
Ok1 := False;
end if;
if (Local >= Local1) then
Val_Boolean := True;
else
Val_Boolean := False;
end if;
when L_Eq =>
Lex_Next_Token (Afile);
Parse_Expr (Ok1, Local1, Afile, Atime);
if not Ok1 then
Ok1 := False;
end if;
if (Local = Local1) then
Val_Boolean := True;
else
Val_Boolean := False;
end if;
when others =>
null;
end case;
end if;
if not Ok1 then
Parse_Error (Afile);
end if;
end Parse_Expr_Bool;
end Calcul;