|
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: 13343 (0x341f)
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 Text_Io;
with Char;
with Lex;
with Registres;
use Lex;
use Registres;
with Elementary_Functions;
use Elementary_Functions;
package body Syntaxe is
package Float_Texte is new Text_Io.Float_Io (Float);
procedure Parse_Error (Afile : Text_Io.File_Type) is
Error : exception;
begin
Text_Io.Put_Line (" Error .. ");
raise Error;
-- while (Lex.Lex_Get_Token /= L_End) loop
-- Lex.Lex_Next_Token (Afile);
-- end loop;
-- Lex.Lex_Next_Token (Afile);
end Parse_Error;
procedure Parse_Fact (Ok : out Boolean;
Value : out Registres.Type_Value;
Afile : Text_Io.File_Type) is
Herited, Local : Type_Value;
Reg : Type_Registre;
Ok1 : 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);
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);
if Ok1 then
Herited := Herited + Sqrt (Local);
else
Ok1 := False;
end if;
when L_Log =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile);
if Ok1 then
Herited := Herited + Log (Local);
else
Ok1 := False;
end if;
when L_Exp =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile);
if Ok1 then
Herited := Herited + Exp (Local);
else
Ok1 := False;
end if;
when L_Sin =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile);
if Ok1 then
Herited := Herited + Sin (Local);
else
Ok1 := False;
end if;
when L_Cos =>
Lex_Next_Token (Afile);
Parse_Fact (Ok, Local, Afile);
if Ok1 then
Herited := Herited + Cos (Local);
else
Ok1 := False;
end if;
when L_Tan =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile);
if Ok1 then
Herited := Herited + Tan (Local);
else
Ok1 := False;
end if;
when L_Arcsin =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile);
if Ok1 then
Herited := Herited + Arcsin (Local);
else
Ok1 := False;
end if;
when L_Arccos =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile);
if Ok1 then
Herited := Herited + Arccos (Local);
else
Ok1 := False;
end if;
when L_Arctan =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile);
if Ok1 then
Herited := Herited + Arctan (Local);
else
Ok1 := False;
end if;
when L_Arccot =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile);
if Ok1 then
Herited := Herited + Arccot (Local);
else
Ok1 := False;
end if;
when L_Cot =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile);
if Ok1 then
Herited := Herited + Cot (Local);
else
Ok1 := False;
end if;
when L_Sinh =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile);
if Ok1 then
Herited := Herited + Sinh (Local);
else
Ok1 := False;
end if;
when L_Cosh =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile);
if Ok1 then
Herited := Herited + Cosh (Local);
else
Ok1 := False;
end if;
when L_Tanh =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile);
if Ok1 then
Herited := Herited + Tanh (Local);
else
Ok1 := False;
end if;
when L_Coth =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile);
if Ok1 then
Herited := Herited + Coth (Local);
else
Ok1 := False;
end if;
when L_Arccosh =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile);
if Ok1 then
Herited := Herited + Arccosh (Local);
else
Ok1 := False;
end if;
when L_Arctanh =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile);
if Ok1 then
Herited := Herited + Arctanh (Local);
else
Ok1 := False;
end if;
when L_Arccoth =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile);
if Ok1 then
Herited := Herited + Arccoth (Local);
else
Ok1 := False;
end if;
when L_Reg =>
Reg := new String'(Lex_Get_Value.all);
Local := Registres.Get_Value_Registre (Reg);
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 Registres.Type_Value;
Afile : Text_Io.File_Type) is
Herited, Local : Type_Value;
Reg : Type_Registre;
Ok1 : Boolean;
Token_Courant : Token;
begin
Ok1 := True;
Parse_Fact (Ok1, Local, Afile);
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);
if Ok1 then
Herited := Herited * Local;
else
Ok1 := False;
end if;
when L_Div =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile);
if Ok1 then
Herited := Herited / Local;
else
Ok1 := False;
end if;
when L_Mod =>
Lex_Next_Token (Afile);
Parse_Fact (Ok1, Local, Afile);
if Ok1 then
Herited := Herited;--mod Local;
else
Ok1 := False;
end if;
when others =>
null;
-- Ok1 := False;
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 Registres.Type_Value;
Afile : Text_Io.File_Type) is
Herited, Local : Type_Value;
Reg : Type_Registre;
Ok1 : Boolean;
Token_Courant : Token;
begin
Ok1 := True;
Parse_Term (Ok1, Local, Afile);
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);
if Ok1 then
Herited := Herited + Local;
else
Ok1 := False;
end if;
when L_Moins =>
Lex_Next_Token (Afile);
Parse_Term (Ok1, Local, Afile);
if Ok1 then
Herited := Herited - Local;
else
Ok1 := False;
end if;
when others =>
null;
-- Ok1 := False;
end case;
end loop;
else
Ok1 := False;
end if;
Value := Herited;
Ok := Ok1;
end Parse_Expr;
function Parse_Inst (Afile : Text_Io.File_Type) return Boolean is
Local : Type_Value;
Reg : Type_Registre;
Ok1 : Boolean;
Token_Courant : Token;
begin
Ok1 := True;
Token_Courant := Lex_Get_Token;
case Token_Courant is
when L_Reg =>
Reg := new String'(Lex_Get_Value.all);
Lex_Next_Token (Afile);
Token_Courant := Lex_Get_Token;
if Token_Courant = L_Eq then
Lex_Next_Token (Afile);
Parse_Expr (Ok1, Local, Afile);
if Ok1 then
Token_Courant := Lex_Get_Token;
if Token_Courant = L_End then
Lex_Next_Token (Afile);
Set_Registre (Reg, Local);
else
Ok1 := False;
end if;
else
Ok1 := False;
end if;
else
Ok1 := False;
end if;
when L_Prt =>
Lex_Next_Token (Afile);
Parse_Expr (Ok1, Local, Afile);
Token_Courant := Lex_Get_Token;
Text_Io.Put_Line (" => "); --& Type_Value'Image (Local));
Float_Texte.Put (Local);
if Token_Courant = L_End then
Lex_Next_Token (Afile);
else
Ok1 := False;
end if;
when L_End =>
Lex_Next_Token (Afile);
when others =>
Ok1 := False;
end case;
return Ok1;
end Parse_Inst;
procedure Parse_Liste (Afile : Text_Io.File_Type) is
begin
if (Lex_Get_Token = L_Proc) then
Lex_Next_Token (Afile);
if (Lex_Get_Token =
L_Reg) then -- identif procedure mais pas registre
Lex_Next_Token (Afile);
if (Lex_Get_Token = L_Begin) then
Lex_Next_Token (Afile);
while (Lex_Get_Token /= L_End) loop
if Parse_Inst (Afile) = False then
Parse_Error (Afile);
end if;
end loop;
else
Parse_Error (Afile);
end if;
else
Parse_Error (Afile);
end if;
else
Parse_Error (Afile);
end if;
end Parse_Liste;
procedure Parse (Afile : Text_Io.File_Type) is
begin
Lex_Next_Token (Afile);
Init_Registres;
Parse_Liste (Afile);
end Parse;
end Syntaxe;