|
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: 46493 (0xb59d)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
└─ ⟦d65440be7⟧ »DATA«
└─⟦this⟧
with Pile_Controle;
with Message_Error;
package body Synt_Sem_Cal is
procedure Parse_Error (Afile : Text_Io.File_Type) is
Error : exception;
begin
Text_Io.Put_Line (" Error .. ");
Text_Io.Put_Line (" line : " &
Text_Io.Positive_Count'Image (Pile_Lex.Line (Afile)));
Text_Io.Put_Line (" col : " &
Text_Io.Positive_Count'Image (Pile_Lex.Col (Afile)));
raise Error;
end Parse_Error;
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;
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 =>
Ptr2 := L_Arbre_Abstrait.Creer_Noeud
(Produit_Cartesien,
L_Arbre_Abstrait.Creer_Feuille
(Registre, null), Ptr1);
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 =>
if Ok then
Ptr2 := L_Arbre_Abstrait.Creer_Noeud
(Object_Inconnu.Le_Type,
Object_Inconnu.L_Arbre_Abstrait,
Ptr1);
else
Ptr2 := L_Arbre_Abstrait.Creer_Noeud
(Produit_Cartesien,
L_Arbre_Abstrait.Creer_Feuille
(Vide, null), Ptr1);
end if;
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 =>
Ptr2 := L_Arbre_Abstrait.Creer_Noeud
(Produit_Cartesien,
L_Arbre_Abstrait.Creer_Feuille
(Registre, null), Ptr1);
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 =>
Pile_Controle.A.Modifier_Parametre_De
(Nom_Ssprg, I, Object_Inconnu, Ok);
if Ok then
Ptr2 :=
L_Arbre_Abstrait.Creer_Noeud
(Object_Inconnu.Le_Type,
Object_Inconnu.L_Arbre_Abstrait,
Ptr1);
else
Ptr2 := L_Arbre_Abstrait.Creer_Noeud
(Produit_Cartesien,
L_Arbre_Abstrait.
Creer_Feuille
(Vide, null), Ptr1);
end if;
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 =>
Ptr2 := L_Arbre_Abstrait.Creer_Noeud
(Produit_Cartesien,
L_Arbre_Abstrait.Creer_Feuille (Registre, null),
Ptr1);
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;
Message_Error.Affiche (L_Dp);
Parse_Error (Afile);
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;
Message_Error.Affiche (3);
Parse_Error (Afile);
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;
Message_Error.Affiche (L_Open);
Parse_Error (Afile);
end if;
return True;
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));
else
P := new String'(Natural'Image (A));
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));
else
if 100 <= A and A <= 999 then
P := new String'("0" & Natural'Image (A));
else
if 1000 <= A and A <= 9999 then
P := new String'(Natural'Image (A));
end if;
end if;
end if;
end if;
return P;
end Valeur_Vers_Chaine;
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);
Ptr1 := Arbre_Abstrait_Types.
L_Arbre_Abstrait.Creer_Noeud
(Effet, Arbre_Abstrait_Types.
L_Arbre_Abstrait.
Creer_Feuille
(Val.Le_Type, null),
Arbre_Abstrait_Types.
L_Arbre_Abstrait.Creer_Feuille
(Vide, null));
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);
Table_Symbole.Rechercher
(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 Ok1 then
null;
if Ok1 then
if Lex_Get_Token = L_Close then
null;
else
Message_Error.Affiche (L_Close);
Parse_Error (Afile);
end if;
else
Parse_Error (Afile);
end if;
else
Message_Error.Affiche (L_Virg);
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
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
Message_Error.Affiche (L_Close);
Parse_Error (Afile);
end if;
else
Message_Error.Affiche (L_Virg);
Parse_Error (Afile);
end if;
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
Message_Error.Affiche (L_Reg);
Parse_Error (Afile);
end if;
else
Message_Error.Affiche (L_Virg);
Parse_Error (Afile);
end if;
else
Message_Error.Affiche (L_Reg);
Parse_Error (Afile);
end if;
else
Message_Error.Affiche (L_Open);
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
null;
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);
else
Parse_Error (Afile);
end if;
else
Parse_Error (Afile);
end if;
end if;
else
Message_Error.Affiche (L_Reg);
Parse_Error (Afile);
end if;
else
Message_Error.Affiche (L_Virg);
Parse_Error (Afile);
end if;
else
Message_Error.Affiche (L_Reg);
Parse_Error (Afile);
end if;
else
Message_Error.Affiche (L_Open);
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;
Message_Error.Affiche (3);
Parse_Error (Afile);
end if;
else
Ok1 := False;
Message_Error.Affiche (L_Faire);
Parse_Error (Afile);
end if;
when L_Debut =>
Lex_Next_Token (Afile);
I := 0;
while (Lex_Get_Token /= L_Fin and I < 10) loop
if (Parse_Inst (Afile, Atime) = True) then
null;
else
Ok1 := False;
Message_Error.Affiche (3);
Parse_Error (Afile);
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
Lex_Next_Token (Afile);
else
Ok1 := False;
Message_Error.Affiche (3);
Parse_Error (Afile);
end if;
when L_Prt =>
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;
Message_Error.Affiche (L_Separ);
Parse_Error (Afile);
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;
Message_Error.Affiche (L_Separ);
Parse_Error (Afile);
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;
Message_Error.Affiche (L_Separ);
Parse_Error (Afile);
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 Lex_Get_Token = L_Debut then
if (Parse_Inst (Afile, Atime) = True) then
null;
else
Ok1 := False;
Message_Error.Affiche (3);
Parse_Error (Afile);
end if;
else
Ok1 := False;
Message_Error.Affiche (L_Debut);
Parse_Error (Afile);
end if;
else
Ok1 := False;
Message_Error.Affiche (L_Que);
Parse_Error (Afile);
end if;
when L_Si =>
Lex_Next_Token (Afile);
Parse_Expr_Bool (Valeur_Boolean, Afile, Atime);
if Lex_Get_Token = L_Alors then
Lex_Next_Token (Afile);
if (Parse_Inst (Afile, Atime) = True) then
null;
else
Ok1 := False;
end if;
if Lex_Get_Token = L_Sinon then
Lex_Next_Token (Afile);
if (Parse_Inst (Afile, Atime) = True) then
null;
else
Ok1 := False;
Message_Error.Affiche (3);
Parse_Error (Afile);
end if;
else
Ok1 := False;
Message_Error.Affiche (L_Sinon);
Parse_Error (Afile);
end if;
else
Ok1 := False;
Message_Error.Affiche (L_Alors);
Parse_Error (Afile);
end if;
when others =>
Ok1 := False;
Message_Error.Affiche (3);
Parse_Error (Afile);
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;
Message_Error.Affiche (L_Close);
Parse_Error (Afile);
end if;
else
Ok1 := False;
Message_Error.Affiche (1);
Parse_Error (Afile);
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;
Message_Error.Affiche (1);
Parse_Error (Afile);
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;
Message_Error.Affiche (1);
Parse_Error (Afile);
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;
Message_Error.Affiche (1);
Parse_Error (Afile);
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);
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;
else
Message_Error.Affiche (L_Reg);
Message_Error.Affiche (6);
Parse_Error (Afile);
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;
Message_Error.Affiche (1);
Parse_Error (Afile);
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;
Message_Error.Affiche (1);
Parse_Error (Afile);
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;
Message_Error.Affiche (1);
Parse_Error (Afile);
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);
Message_Error.Affiche (2);
Parse_Error (Afile);
end if;
end Parse_Expr_Bool;
end Synt_Sem_Cal;