Скачиваний:
14
Добавлен:
01.05.2014
Размер:
26.86 Кб
Скачать
unit uRules;

interface
uses uTable;

function ExecRule(num: integer; curtab: byte):string;
procedure ExecPer(lex:string);
// Функции перевода для основной грамматики
function mainrule1: string; // program
function mainrule5: string; // label
function mainrule9: string; // idc = exp .. exp ;
function mainrule11: string; // idt[exp,exp] ;
function mainrule28: string; // idv : idt ;
function mainrule29: string; // var ;
function mainrule31: string; // idc = exp ;
function mainrule32: string; // idc:idt = exp ;
// Функции перевода для грамматики оператора
function oprule10: string; // := ;
function oprule11: string; // := ;
function oprule12: string; // goto ;
function oprule14: string; // writeln ;
function oprule17: string; // repeat until ;
function oprule19: string; // read ;
function oprule20: string; // readln ;
function oprule21: string; // write ;
function oprule26: string; // if then else ;

// Функции перевода для грамматики выражения//
function virRule2: string; // C<
function virRule3: string; // C>
function virRule4: string; // C<=
function virRule5: string; // C>=
function virRule6: string; // C<>
function virRule7: string; // C=
//function virRule8: string; // idv
function virRule11: string; // ELEM
//function virRule12: string; // ELEM
function virRule13: string; // NOT
function virRule14: string; // SUB0
function virRule16: string; // AND
function virRule18: string; // DIV
function virRule19: string; // MOD
function virRule20: string; // SHL
function virRule21: string; // SHR
function virRule23: string; // MUL
function virRule25: string; // OR
function virRule26: string; // XOR
function virRule28: string; // SUB
function virRule29: string; // ADD


implementation

uses uMain, sysutils, uOutput;

//вспомогательные процедуры и функции
procedure GetNV(var X,Y:string; n1,v1,n2,v2:integer; t1:integer=1;t2:integer=1);
begin
case n1 of
-1: X := '(' + inttostr(v1) + ')';
0: X := inttostr(v1);
else if (v1=-1) then X := 'v' + inttostr(n1)
else if (t1=6) {boolean} then
begin
if v1=0 then X:='false' else X:='true';
end
else X := inttostr(v1);
end;
case n2 of
-1: Y := '(' + inttostr(v2) + ')';
0: Y := inttostr(v2);
else if (v2=-1) then Y := 'v' + inttostr(n2)
else if (t2=6) {boolean} then
begin
if v2=0 then Y:='false' else Y:='true';
end
else Y := inttostr(v2);
end;
end;

// Процедура запуска правила

function ExecRule(num: integer; curtab: byte):string;
var res: string;
begin
case curtab of
0: case num of
1 : res:=mainRule1;
5 : res:=mainRule5;
6 : res:=mainRule5;
9 : res:=mainRule9;
11 : res:=mainRule11;
27 : res:=mainRule28;
28 : res:=mainRule28;
29 : res:=mainRule29;
30 : res:=mainRule29;
31 : res:=mainRule31;
32 : res:=mainRule32;
end;
1: case num of
2 : res:=opRule26;
10 : res:=opRule10;
11 : res:=opRule11;
12 : res:=opRule12;
14 : res:=opRule14;
16 : res:=opRule14;
17 : res:=opRule17;
19 : res:=opRule19;
20 : res:=opRule20;
21 : res:=opRule21;
22 : res:=opRule21;
25 : res:=opRule26;
26 : res:=opRule26;
27 : res:=opRule26;
end;
2: case num of
2: res := virRule2;
3: res := virRule3;
4: res := virRule4;
5: res := virRule5;
6: res := virRule6;
7: res := virRule7;
11: res := virRule11;
12: res := virRule11;
13: res := virRule13;
14: res := virRule14;
16: res := virRule16;
18: res := virRule18;
19: res := virRule19;
20: res := virRule20;
21: res := virRule21;
23: res := virRule23;
25: res := virRule25;
26: res := virRule26;
28: res := virRule28;
29: res := virRule29;
end;
end;
ExecRule:=res;
if res<>'' then
begin
raise Exception.Create(res);
end;
if fmMain.tbtest.down then
begin
fmOutput.mmTest.Lines.Add('Свертка по правилу '+inttostr(num)+' грамматики '+inttostr(curtab)); // Строка для создания теста
fmOutput.mmTest.Lines.Add(attrs.listingint); // Строка для создания теста
end;
end;

procedure ExecPer(lex:string);
var nl,t,v,n:integer;
X:string;
begin
if lex = 'idv' then
begin
attrs.Push(strtoint(fmMain.sgvar.Cells[2, numvar]));
attrs.Push(-1);
attrs.Push(numvar);
end else
if lex = 'idc' then
begin
if fmMain.sgConst.Cells[3, numconst][1]='(' then
begin
attrs.Push(strtoint(fmMain.sgConst.Cells[2, numconst]));
lex:=fmMain.sgConst.Cells[3, numconst];
delete(lex,1,1);
delete(lex,length(lex),1);
attrs.Push(strtoint(lex));
lex:='idc';
attrs.Push(-1);
end
else
if fmMain.sgConst.Cells[3, numconst]='true' then
begin
attrs.Push(strtoint(fmMain.sgConst.Cells[2, numconst]));
attrs.Push(1);
attrs.Push(numconst);
end
else
if fmMain.sgConst.Cells[3, numconst]='false' then
begin
attrs.Push(strtoint(fmMain.sgConst.Cells[2, numconst]));
attrs.Push(0);
attrs.Push(numconst);
end
else
begin
attrs.Push(strtoint(fmMain.sgConst.Cells[2, numconst]));
attrs.Push(strtoint(fmMain.sgConst.Cells[3, numconst]));
attrs.Push(numconst);
end;
end else
if lex = 'idn' then
begin
attrs.Push(5);
attrs.Push(number);
attrs.Push(0);
end;
if lex = 'str' then
begin
attrs.Push(0); //t<--string
attrs.Push(numstr);
attrs.Push(-2);
end;
if lex = 'w11' then
begin
attrs.Push(fmTable.Triads.Count+1);
end;
if lex = 'idl' then
begin
attrs.Push(numlabel);
end;
if lex = 'idt' then
begin
attrs.Push(numtype);
end;
if (lex = ':') and (curtab=1) then
begin
fmTable.Triads.Add('DEFL l'+inttostr(attrs.popint)+ ',');
end;
if (lex = 'w1') then //then
begin
n := attrs.Popint;
v := attrs.Popint;
t := attrs.Popint;
if t=6 then
begin
GetNV(X,X,n,v,n,v);
AddtoGrid(fmMain.sgLabel, 'ifthen'+inttostr(fmMain.sgLabel.RowCount-1));
fmMain._label.Add(fmMain.sgLabel.Cells[1,fmMain.sgLabel.RowCount-2]);
fmTable.Triads.Add('JFL l'+inttostr(fmMain.sgLabel.RowCount-2)+ ','+X);
attrs.Push(fmMain.sgLabel.RowCount-2);
end
else raise Exception.Create('Неверный тип выражения в if');
end;
if (lex = 'w12') then //else
begin
AddtoGrid(fmMain.sgLabel, 'ifelse'+inttostr(fmMain.sgLabel.RowCount-1));
fmMain._label.Add(fmMain.sgLabel.Cells[1,fmMain.sgLabel.RowCount-2]);
fmTable.Triads.Add('JMP l'+inttostr(fmMain.sgLabel.RowCount-2)+ ',');
nl:=attrs.Popint;
fmTable.Triads.Add('DEFL l'+inttostr(nl)+ ',');
attrs.Push(fmMain.sgLabel.RowCount-2);
end;
if fmMain.tbtest.down then
begin
fmOutput.mmTest.Lines.Add('Перенос символа '+lex); //Строка для создания теста
fmOutput.mmTest.Lines.Add(attrs.listingint); //Строка для создания теста
end;
end;

function mainrule1: string; // program
begin
attrs.Pop;
attrs.Pop;
attrs.Pop;
mainrule1:='';
end;

function mainrule5: string; // program
begin
attrs.Pop;
mainrule5:='';
end;

function mainrule9: string; // idc = exp .. exp ;
var t1, t2, v1, v2, n1, n2,t: integer;
X,Y:string;
begin
mainrule9:='';
n2 := attrs.Popint;
v2 := attrs.Popint;
t2 := attrs.Popint;
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
t := attrs.Popint;
GetNV(X,Y,n1,v1,n2,v2);
if (comptab[t1,t2]<>0) and (t1<>6) and (t2<>6) and (t1<>7) and (t2<>7) then
begin
if digit(X[1]) and digit(Y[1]) then
begin
v1:=strtoint(X);
v2:=strtoint(Y);
if v1>v2 then mainrule9:='Ошибка, константа слева должна быть меньше константы справа';
end;
fmMain.sgType.Cells[2,t]:=inttostr(8); // диапазон
end
else mainrule9:='Типы констант в диапазоне не совместимы';
end;

function mainrule11: string;
var t1, t2, v1, v2, n1, n2,t: integer;
X,Y:string;
begin
mainrule11:='';
n2 := attrs.Popint;
v2 := attrs.Popint;
t2 := attrs.Popint;
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
// t := attrs.Popint;
GetNV(X,Y,n1,v1,n2,v2);
if (comptab[t1,t2]<>0) and (t1<>6) and (t2<>6) and (t1<>7) and (t2<>7) then
begin
fmMain.sgType.Cells[2,t]:=inttostr(7); // boolmatr
end
else mainrule11:='Типы констант в индексе не совместимы';
end;


function mainrule28: string; // idv : idt ;
var t1, v1, n1, t2, v2, n2, t3, v3, n3 : integer;
X,Y : string;
begin
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
GetNV(X,X,n1,v1,n1,v1);
if t1=7 then
begin
fmTable.Triads.Add('VAR ' + X + ',' +fmMain.sgType.Cells[1,strtoint(fmMain.sgVar.Cells[2,n1])]);
fmTable.Triads.Add('ARG ' + 'm' + ',' +'n');
end
else
begin
fmTable.Triads.Add('VAR ' + X + ',' +fmMain.sgType.Cells[1,strtoint(fmMain.sgVar.Cells[2,n1])]);
fmMain.sgVar.Cells[2,n1]:=fmMain.sgType.Cells[2,strtoint(fmMain.sgVar.Cells[2,n1])];
end;
mainrule28:='';
end;

function mainrule29: string; // idc = exp ;
begin
attrs.Pop;
mainrule29:='';
end;

function mainrule31: string; // idc = exp ;
var t1, t2, v1, v2, n1, n2: integer;
X:string;
begin
mainrule31:='';
n2 := attrs.Popint;
v2 := attrs.Popint;
t2 := attrs.Popint;
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
GetNV(X,X,n2,v2,n2,v2,t2,t2);
fmMain.sgConst.Cells[3,n1]:=X;
if t2<>7 then fmMain.sgConst.Cells[2,n1]:=inttostr(t2)
else mainrule31:='Недопустимый тип константы';
end;

function mainrule32: string; // idc:idt = exp ;
var t1, t2, v1, v2, n1, n2, t: integer;
X:string;
begin
mainrule32:='';
n2 := attrs.Popint;
v2 := attrs.Popint;
t2 := attrs.Popint;
t := attrs.Popint;
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
case n2 of
-1: X := '(' + inttostr(v2) + ')';
0: X := inttostr(v2);
else X := 'v' + inttostr(n2);
end;
fmMain.sgConst.Cells[3,n1]:=X;
if t2<>7 then fmMain.sgConst.Cells[2,n1]:=inttostr(t2)
else mainrule32:='Недопустимый тип константы';
end;

function oprule10: string; // repeat until ;
var t1, t2, v1, v2, n1, n2: integer;
X:string;
begin
n2 := attrs.Popint;
v2 := attrs.Popint;
t2 := attrs.Popint;
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
GetNV(X,X,n2,v2,n2,v2,t2,t2);
if comptab[t1,t2]<>0 then
begin
if n1>0 then
begin
fmTable.Triads.Add('EQU '+X+ ',v' + inttostr(n1));
oprule10:='';
end
else oprule10:='В операторе присваивания слева должна быть переменная';
end else oprule10:='Несовместимые типы'
end;

function oprule11: string; // := ;
var t1, t2, t3, v1, v2, v3, n1, n2, n3, t, v,n: integer;
X,Y,Z:string;
begin
oprule11:='';
n3 := attrs.Popint;
v3 := attrs.Popint;
t3 := attrs.Popint;
n2 := attrs.Popint;
v2 := attrs.Popint;
t2 := attrs.Popint;
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
GetNV(Z,Z,n3,v3,n3,v3,t3,t3);
GetNV(X,Y,n1,v1,n2,v2,t1,t2);
n := attrs.Popint;
v := attrs.Popint;
t := attrs.Popint;
if (comptab[6,t3]<>0) and (t=7) then
begin
if (t2<>6) and (t2<>7) and (t1<>6) and (t1<>7) then
begin
if n>0 then
begin
fmTable.Triads.Add('EQU '+Z+ ',v' + inttostr(n));
fmTable.Triads.Add('ARG '+X + ',' + Y);
oprule11:='';
end
else oprule11:='В операторе присваивания слева должна быть переменная';
end else oprule11:='Ошибка типа идекса'
end else oprule11:='Несовместимые типы'
end;

function oprule12: string; // goto ;
var nl : integer;
begin
nl := attrs.Popint;
fmTable.Triads.Add('JMP l' +inttostr(nl) + ',' );
oprule12:='';
end;

function oprule14: string; // writeln ;
begin
fmTable.Triads.Add('WRITE #13#10,');
end;

function oprule17: string; // repeat until ;
var t1, v1, n1, nl : integer;
X : string;
begin
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
GetNV(X,X,n1,v1,n1,v1);
nl := attrs.Popint;
if t1=6 then
begin
fmTable.Triads.Add('JF (' +inttostr(nl) + '),' + X);
oprule17:='';
end else oprule17:='Неверный тип выражения в until'
end;

function oprule19: string; // read ;
var t1, v1, n1 : integer;
X : string;
begin
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
if (t1<>7) then
if n1>0 then
begin
fmTable.Triads.Add('READ v' + inttostr(n1) + ','+fmMain.sgType.Cells[1,strtoint(fmMain.sgType.Cells[2,t1])]);
oprule19:='';
end
else oprule19:='Ожидалась переменная в Read'
else oprule19:='Невозможно прочитать переменную типа boolmatr';
end;

function oprule20: string; // readln ;
var t1, v1, n1 : integer;
X : string;
begin
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
if (t1<>7) then
if n1>0 then
begin
fmTable.Triads.Add('READ v' + inttostr(n1) + ','+fmMain.sgType.Cells[1,strtoint(fmMain.sgType.Cells[2,t1])]);
fmTable.Triads.Add('WRITE #13#10,');
oprule20:='';
end
else oprule20:='Ожидалась переменная в Readln'
else oprule20:='Невозможно прочитать переменную типа boolmatr';
end;



function oprule21: string; // write ;
var t1, v1, n1 : integer;
X : string;
begin
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
if t1=0 then //строка
fmTable.Triads.Add('WRITE ''' + fmMain.sgConstStr.Cells[1,v1] + ''',')
else
if t1<>7 then
begin
GetNV(X,X,n1,v1,n1,v1);
fmTable.Triads.Add('WRITE ' + X + ',');
oprule21:='';
end else oprule21:='Невозможно вывести значение типа boolmatr'
end;

function oprule26: string; // if ;
var nl : integer;
begin
nl := attrs.Popint;
fmTable.Triads.Add('DEFL l'+inttostr(nl)+ ',');
oprule26:='';
end;


function virRule2: string;
var t1, t2, v1, v2, n1, n2: integer;
X, Y: string;
begin
n2 := attrs.Popint;
v2 := attrs.Popint;
t2 := attrs.Popint;
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
GetNV(X,Y,n1,v1,n2,v2,t1,t2);
if comptab[t1, t2] <> 0 then
begin
fmTable.Triads.Add('CL ' + X + ',' + Y);
fmTable.SeqExec.Add(inttostr(fmTable.Triads.Count));
attrs.Push(6); // t<-boolean
attrs.Push(fmTable.Triads.Count); // v <- №
attrs.Push(-1); // n<- -1
virrule2 := '';
end
else virrule2 := 'Ошибка в выражении (несовместимость типов)';
end;

function virRule3: string;
var t1, t2, v1, v2, n1, n2: integer;
X, Y: string;
begin
n2 := attrs.Popint;
v2 := attrs.Popint;
t2 := attrs.Popint;
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
if comptab[t1, t2] <> 0 then
begin
GetNV(X,Y,n1,v1,n2,v2,t1,t2);
fmTable.Triads.Add('CG ' + X + ',' + Y);
fmTable.SeqExec.Add(inttostr(fmTable.Triads.Count));
attrs.Push(6); // t<-boolean
attrs.Push(fmTable.Triads.Count); // v <- №
attrs.Push(-1); // n<- -1
virrule3 := '';
end
else virrule3 := 'Ошибка в выражении (несовместимость типов)';
end;

function virRule4: string;
var t1, t2, v1, v2, n1, n2: integer;
X, Y: string;
begin
n2 := attrs.Popint;
v2 := attrs.Popint;
t2 := attrs.Popint;
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
if comptab[t1, t2] <> 0 then
begin
GetNV(X,Y,n1,v1,n2,v2,t1,t2);
fmTable.Triads.Add('CLE ' + X + ',' + Y);
fmTable.SeqExec.Add(inttostr(fmTable.Triads.Count));
attrs.Push(6); // t<-boolean
attrs.Push(fmTable.Triads.Count); // v <- №
attrs.Push(-1); // n<- -1
virrule4 := '';
end
else virrule4 := 'Ошибка в выражении (несовместимость типов)';
end;

function virRule5: string;
var t1, t2, v1, v2, n1, n2: integer;
X, Y: string;
begin
n2 := attrs.Popint;
v2 := attrs.Popint;
t2 := attrs.Popint;
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
if comptab[t1, t2] <> 0 then
begin
GetNV(X,Y,n1,v1,n2,v2,t1,t2);
fmTable.Triads.Add('CGE ' + X + ',' + Y);
fmTable.SeqExec.Add(inttostr(fmTable.Triads.Count));
attrs.Push(6); // t<-boolean
attrs.Push(fmTable.Triads.Count); // v <- №
attrs.Push(-1); // n<- -1
virrule5 := '';
end
else virrule5 := 'Ошибка в выражении (несовместимость типов)';
end;


function virRule6: string;
var t1, t2, v1, v2, n1, n2: integer;
X, Y: string;
begin
n2 := attrs.Popint;
v2 := attrs.Popint;
t2 := attrs.Popint;
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
if comptab[t1, t2] <> 0 then
begin
GetNV(X,Y,n1,v1,n2,v2,t1,t2);
fmTable.Triads.Add('CNE ' + X + ',' + Y);
fmTable.SeqExec.Add(inttostr(fmTable.Triads.Count));
attrs.Push(6); // t<-boolean
attrs.Push(fmTable.Triads.Count); // v <- №
attrs.Push(-1); // n<- -1
virrule6 := '';
end
else virrule6 := 'Ошибка в выражении (несовместимость типов)';
end;

function virRule7: string;
var t1, t2, v1, v2, n1, n2: integer;
X, Y: string;
begin
n2 := attrs.Popint;
v2 := attrs.Popint;
t2 := attrs.Popint;
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
if comptab[t1, t2] <> 0 then
begin
GetNV(X,Y,n1,v1,n2,v2,t1,t2);
fmTable.Triads.Add('CE ' + X + ',' + Y);
fmTable.SeqExec.Add(inttostr(fmTable.Triads.Count));
attrs.Push(6); // t<-boolean
attrs.Push(fmTable.Triads.Count); // v <- №
attrs.Push(-1); // n<- -1
virrule7 := '';
end
else virrule7 := 'Ошибка в выражении (несовместимость типов)';
end;

function virRule11: string; // ELEM
var t1, t2, t3, v1, v2, n1, n2, n3: integer;
X, Y: string;
begin
n2 := attrs.Popint;
v2 := attrs.Popint;
t2 := attrs.Popint;
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
n3 := attrs.Popint;
t3 := attrs.Popint;
t3 := attrs.Popint;
if (t3 = 7) and (t2<>6) and (t2<>7) and (t1<>6) and (t1<>7) then
begin
GetNV(X,Y,n1,v1,n2,v2);
fmTable.Triads.Add('ELM v' + inttostr(n3)+',' + X);
fmTable.Triads.Add('ARG ' + Y +',');
fmTable.SeqExec.Add(inttostr(fmTable.Triads.Count));
attrs.Push(6); // t<-boolean
attrs.Push(fmTable.Triads.Count-1); // v <- №
attrs.Push(-1); // n<- -1
virrule11 := '';
end
else virrule11 := 'Ошибка обращения к элементу матрицы';
end;

function virRule13: string; // NOT
var t1, v1, n1 : integer;
X : string;
begin
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
GetNV(X,X,n1,v1,n1,v1,t1,t1);
fmTable.Triads.Add('NOT ' + X + ',');
fmTable.SeqExec.Add(inttostr(fmTable.Triads.Count));
attrs.Push(t1); // t<-boolean
attrs.Push(fmTable.Triads.Count); // v <- №
attrs.Push(-1); // n<- -1
virrule13 := '';
end;


function virRule14: string; // SUB0
var t1, v1, n1 : integer;
X : string;
begin
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
GetNV(X,X,n1,v1,n1,v1,t1,t1);
if t1<>fmMain._type.IndexOf('boolean')+1 then
begin
fmTable.Triads.Add('SUB 0,' + X);
fmTable.SeqExec.Add(inttostr(fmTable.Triads.Count));
attrs.Push(comptab[t1,fmMain._type.IndexOf('shortint')+1]); // t<-boolean
attrs.Push(fmTable.Triads.Count); // v <- №
attrs.Push(-1); // n<- -1
virrule14 := '';
end else virrule14 := 'Ошибка в выражении (несовместимость типов)';
end;

function virRule16: string; // AND
var t1, t2, v1, v2, n1, n2: integer;
X, Y: string;
begin
n2 := attrs.Popint;
v2 := attrs.Popint;
t2 := attrs.Popint;
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
if comptab[t1, t2] <> 0 then
begin
GetNV(X,Y,n1,v1,n2,v2,t1,t2);
fmTable.Triads.Add('AND ' + X + ',' + Y);
fmTable.SeqExec.Add(inttostr(fmTable.Triads.Count));
attrs.Push(comptab[t1, t2]); // t<-boolean
attrs.Push(fmTable.Triads.Count); // v <- №
attrs.Push(-1); // n<- -1
virrule16 := '';
end
else virrule16 := 'Ошибка в выражении (несовместимость типов)';
end;

function virRule18: string; // DIV
var t1, t2, v1, v2, n1, n2: integer;
X, Y: string;
begin
n2 := attrs.Popint;
v2 := attrs.Popint;
t2 := attrs.Popint;
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
if (comptab[t1, t2] <> 0) and (t1<>6) and (t2<>6) then
begin
GetNV(X,Y,n1,v1,n2,v2,t1,t2);
fmTable.Triads.Add('DIV ' + X + ',' + Y);
fmTable.SeqExec.Add(inttostr(fmTable.Triads.Count));
attrs.Push(comptab[t1, t2]); // t<-boolean
attrs.Push(fmTable.Triads.Count); // v <- №
attrs.Push(-1); // n<- -1
virrule18 := '';
end
else virrule18 := 'Ошибка в выражении (несовместимость типов)';
end;

function virRule19: string; // MOD
var t1, t2, v1, v2, n1, n2: integer;
X, Y: string;
begin
n2 := attrs.Popint;
v2 := attrs.Popint;
t2 := attrs.Popint;
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
if (comptab[t1, t2] <> 0) and (t1<>6) and (t2<>6) then
begin
GetNV(X,Y,n1,v1,n2,v2,t1,t2);
fmTable.Triads.Add('MOD ' + X + ',' + Y);
fmTable.SeqExec.Add(inttostr(fmTable.Triads.Count));
attrs.Push(comptab[t1, t2]); // t<-boolean
attrs.Push(fmTable.Triads.Count); // v <- №
attrs.Push(-1); // n<- -1
virrule19 := '';
end
else virrule19 := 'Ошибка в выражении (несовместимость типов)';
end;

function virRule20: string; // SHL
var t1, t2, v1, v2, n1, n2: integer;
X, Y: string;
begin
n2 := attrs.Popint;
v2 := attrs.Popint;
t2 := attrs.Popint;
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
if (comptab[t1, t2] <> 0) and (t1<>6) and (t2<>6) then
begin
GetNV(X,Y,n1,v1,n2,v2,t1,t2);
fmTable.Triads.Add('SHL ' + X + ',' + Y);
fmTable.SeqExec.Add(inttostr(fmTable.Triads.Count));
attrs.Push(comptab[t1, t2]); // t<-boolean
attrs.Push(fmTable.Triads.Count); // v <- №
attrs.Push(-1); // n<- -1
virrule20 := '';
end
else virrule20 := 'Ошибка в выражении (несовместимость типов)';
end;

function virRule21: string; // SHR
var t1, t2, v1, v2, n1, n2: integer;
X, Y: string;
begin
n2 := attrs.Popint;
v2 := attrs.Popint;
t2 := attrs.Popint;
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
if (comptab[t1, t2] <> 0) and (t1<>6) and (t2<>6) then
begin
GetNV(X,Y,n1,v1,n2,v2,t1,t2);
fmTable.Triads.Add('SHR ' + X + ',' + Y);
fmTable.SeqExec.Add(inttostr(fmTable.Triads.Count));
attrs.Push(comptab[t1, t2]); // t<-boolean
attrs.Push(fmTable.Triads.Count); // v <- №
attrs.Push(-1); // n<- -1
virrule21 := '';
end
else virrule21 := 'Ошибка в выражении (несовместимость типов)';
end;

function virRule23: string; // MUL
var t1, t2, v1, v2, n1, n2: integer;
X, Y: string;
begin
n2 := attrs.Popint;
v2 := attrs.Popint;
t2 := attrs.Popint;
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
if (comptab[t1, t2] <> 0) and (t1<>6) and (t2<>6) then
begin
GetNV(X,Y,n1,v1,n2,v2,t1,t2);
fmTable.Triads.Add('MUL ' + X + ',' + Y);
fmTable.SeqExec.Add(inttostr(fmTable.Triads.Count));
attrs.Push(comptab[t1, t2]); // t<-boolean
attrs.Push(fmTable.Triads.Count); // v <- №
attrs.Push(-1); // n<- -1
virrule23 := '';
end
else virrule23 := 'Ошибка в выражении (несовместимость типов)';
end;

function virRule25: string; // OR
var t1, t2, v1, v2, n1, n2: integer;
X, Y: string;
begin
n2 := attrs.Popint;
v2 := attrs.Popint;
t2 := attrs.Popint;
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
if comptab[t1, t2] <> 0 then
begin
GetNV(X,Y,n1,v1,n2,v2,t1,t2);
fmTable.Triads.Add('OR ' + X + ',' + Y);
fmTable.SeqExec.Add(inttostr(fmTable.Triads.Count));
attrs.Push(comptab[t1, t2]); // t<-boolean
attrs.Push(fmTable.Triads.Count); // v <- №
attrs.Push(-1); // n<- -1
virrule25 := '';
end
else virrule25 := 'Ошибка в выражении (несовместимость типов)';
end;

function virRule26: string; // XOR
var t1, t2, v1, v2, n1, n2: integer;
X, Y: string;
begin
n2 := attrs.Popint;
v2 := attrs.Popint;
t2 := attrs.Popint;
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
if comptab[t1, t2] <> 0 then
begin
GetNV(X,Y,n1,v1,n2,v2,t1,t2);
fmTable.Triads.Add('XOR ' + X + ',' + Y);
fmTable.SeqExec.Add(inttostr(fmTable.Triads.Count));
attrs.Push(comptab[t1, t2]); // t<-boolean
attrs.Push(fmTable.Triads.Count); // v <- №
attrs.Push(-1); // n<- -1
virrule26 := '';
end
else virrule26 := 'Ошибка в выражении (несовместимость типов)';
end;

function virRule28: string; // SUB
var t1, t2, v1, v2, n1, n2: integer;
X, Y: string;
begin
n2 := attrs.Popint;
v2 := attrs.Popint;
t2 := attrs.Popint;
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
if (comptab[t1, t2] <> 0) then
begin
if (t1<>6) and (t2<>6) then
begin
GetNV(X,Y,n1,v1,n2,v2,t1,t2);
fmTable.Triads.Add('SUB ' + X + ',' + Y);
fmTable.SeqExec.Add(inttostr(fmTable.Triads.Count));
attrs.Push(comptab[t1, t2]); // t<-boolean
attrs.Push(fmTable.Triads.Count); // v <- №
attrs.Push(-1); // n<- -1
virrule28 := '';
end else virrule28:='Нельзя использовать эту операцию для этого типа ';
end else virrule28 := 'Ошибка в выражении (несовместимость типов)';
end;

function virRule29: string; // ADD
var t1, t2, v1, v2, n1, n2: integer;
X, Y: string;
begin
n2 := attrs.Popint;
v2 := attrs.Popint;
t2 := attrs.Popint;
n1 := attrs.Popint;
v1 := attrs.Popint;
t1 := attrs.Popint;
if (comptab[t1, t2] <> 0) then
begin
if (t1<>6) and (t2<>6) then
begin
GetNV(X,Y,n1,v1,n2,v2,t1,t2);
fmTable.Triads.Add('ADD ' + X + ',' + Y);
fmTable.SeqExec.Add(inttostr(fmTable.Triads.Count));
attrs.Push(comptab[t1, t2]); // t<-boolean
attrs.Push(fmTable.Triads.Count); // v <- №
attrs.Push(-1); // n<- -1
virrule29 := '';
end
else virrule29:='Нельзя использовать эту операцию для этого типа ';
end else virrule29 := 'Ошибка в выражении (несовместимость типов)';
end;

end.

Соседние файлы в папке sinan
  • #
    01.05.2014413 б13uOutput.pas
  • #
    01.05.201433 б13uOutput.~ddp
  • #
    01.05.20141.24 Кб13uOutput.~dfm
  • #
    01.05.2014413 б14uOutput.~pas
  • #
    01.05.201431.96 Кб13uRules.dcu
  • #
    01.05.201426.86 Кб14uRules.pas
  • #
    01.05.201426.87 Кб13uRules.~pas
  • #
    01.05.201421.67 Кб13uTable.dcu
  • #
    01.05.201451 б13uTable.ddp
  • #
    01.05.20144.07 Кб13uTable.dfm
  • #
    01.05.201417.47 Кб13uTable.pas