Interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm2 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2 : TForm2;
implementation
uses Unit1;
{$R *.dfm}
end.
unit Unit3;
Interface
var
//ErrorCode : integer;
TG : array [1..256] of string;
DjekstrError:integer;
SpisPerem:array [1..20] of string;
SemanticError:integer;
io:integer;
isim,im,iloop:integer;
operator,sim,metka,Operation:array [1..20] of string;
ErrorCodeGenerate:integer;
function prog(var i:integer):integer;
procedure SpisPeremPush ();
procedure OPREDELENIE();
implementation
uses Unit1, SysUtils;
function spis_perem2(var i : integer):integer;forward;
function spis_opis2(var i : integer):integer;forward;
function oper(var i : integer): integer;forward;
function spis_oper(var i : integer): integer;forward;
function spis_oper2(var i:integer):integer;forward;
function TransletPascalToAssembler(pice:string):integer;forward;
///////////////////////////////////////////////////////
procedure OPREDELENIE();
begin
io:=1;
isim:=1;
im:=1;
end;
procedure addO (s:string);
begin
if s=':=' then
begin
operator[io]:=s;
inc(io);
end
else
begin
operator[io]:=s;
inc(io);
end;
end;
procedure addS (s:string);
begin
sim[isim]:=s;
inc(isim);
end;
procedure vitolk(s:string);
var met:string;
begin
met:=operator[io-1];
met:=met+sim[isim-2];
met:=met+sim[isim-1];
dec(io);
isim:=isim-2;
metka[im]:=met;
sim[isim]:='M';
inc(isim);
operator[io]:=s;
inc(io);
end;
function DX(s:string):integer;
var
loop:integer;
met:string;
begin
if s[1] in ['a'..'z','A'..'Z'] then
begin
addS(s);
end
else
if s[1] in ['0'..'9'] then
begin
addS(s);
end
else
if s[1] in ['+','-'] then
begin
if operator[io-1]='+' then
begin
vitolk(s);
end;
addO(s);
end
else
if s[1] in ['*','/'] then
begin
addO(s);
end
else
if s=':=' then
begin
addO(s);
end
else
if s='$' then
begin
if io>=3 then begin
while isim>2 do
begin
if io=2 then begin break; end;
met:=operator[io-1]+' '+sim[isim-2]+','+sim[isim-1];
dec(io);
isim:=isim-2;
metka[im]:=met;
sim[isim]:='M'+IntToStr(im);
form1.Memo2.Lines.Add('M'+IntToStr(im)+'='+metka[im]);
//form1.Memo1.Lines.Add(metka[im]);
TransletPascalToAssembler('Viraj1Pice');
//add
im:=im+1;
isim:=isim+1;
end;
end;
form1.Memo2.Lines.Add(operator[io-1]+' '+sim[isim-2]+','+sim[isim-1]);
TransletPascalToAssembler('Viraj2Pice');
dec(io);
isim:=isim-2;
end;
end;
///////////////////////////////////////////////////////
procedure SpisPeremPush ();
var loop:integer;
begin
loop:=1;
while form1.ListBox2.Items[loop]<>'begin' do
begin
if (form1.ListBox2.Items[loop]=':')
or (form1.ListBox2.Items[loop]='integer')
or (form1.ListBox2.Items[loop]=';')
or (form1.ListBox2.Items[loop]=',') then
begin
inc(loop);
end
else
begin
SpisPerem[loop]:=form1.ListBox2.Items[loop];
inc(loop);
end;
end;
end;
function Skan(var s:string):integer;
var loop:integer;
begin
for loop:=1 to length(SpisPerem) do
begin
if s=SpisPerem[loop] then
begin
Result:=0;
exit;
end;
end;
Result:=1;
end;
function Simantic (var str:string):integer;
var loop:integer;
s:string;
begin
//add
loop:=1;
while loop<>length(str) do
begin
if (str[loop]=':') or (str[loop]='=') or (str[loop]='+')
or (str[loop]='-') or (str[loop]='*') or (str[loop]='/')
or (str[loop]='^') then begin inc(loop); end else
begin
s:=str[loop];
if Skan(s)<>0 then begin Result:=1;exit;end
else begin Result:=0; inc(loop); end;
end;
end;
end;
///////////////////////////////////////////////////////
procedure OperandToString (virag:string;id:integer);
var instr,outstr:string;
semantic:string;
begin
dec(id);
while TG[id]<>'T(14)'do
begin
instr:=instr+TG[id];
dec(id);
end;
instr:=instr+TG[id];
dec(id);
instr:=instr+TG[id];
while (TG[id]<>'T(9)')and(TG[id]<>'T(5)')do
begin
outstr:=form1.ListBox2.Items[id-1];
semantic:=semantic+form1.ListBox2.Items[id-1];
DX(outstr);
inc(id);
end;
if (TG[id]='T(9)')or(TG[id]='T(5)') then
begin
outstr:='$';
DX(outstr);
end;
if Simantic(semantic)<>0 then begin SemanticError:=1; exit; end;
//add
//TransletPascalToAssembler('OperationPice');
end;
///////////////////////////////////////////////////////
function spis_perem1(var i : integer):integer;
var ErrorCode : integer;
begin
if TG[i]<>'T(8)'then begin Result:=1; exit; end;
inc(i);
if TG[i]<>'I'then begin Result:=1; exit; end;
inc(i);
Result:=spis_perem2(i);
end;
function spis_perem2(var i : integer):integer;
var ErrorCode : integer;
begin
if TG[i]='T(8)'then begin Result:=spis_perem1(i); end;
if TG[i]='T(13)'then begin Result:=0; exit; end;
end;
function spis_perem(var i : integer):integer;
var ErrorCode : integer;
begin
if TG[i]<>'I'then begin Result:=1; exit; end;
inc(i);
Result:=spis_perem2(i);
end;
function opis(var i : integer):integer;
var ErrorCode : integer;
begin
ErrorCode:=spis_perem(i);
if ErrorCode<>0 then begin Result:=ErrorCode; exit; end;
if TG[i]<>'T(13)'then begin Result:=1; exit; end;
inc(i);
if TG[i]<>'T(2)'then begin Result:=1; exit; end;
inc(i);
Result:=0;
end;
function spis_opis1(var i : integer):integer;
var ErrorCode : integer;
begin
if TG[i]<>'T(9)'then begin Result:=0; exit; end;
inc(i);
if TG[i]<>'I'then begin Result:=0; exit; end;
ErrorCode:=opis(i);
if ErrorCode<>0 then begin Result:=1; exit; end;
Result:=spis_opis2(i);
end;
function spis_opis2(var i : integer):integer;
var ErrorCode : integer;
begin
if TG[i]<>'T(9)'then begin Result:=1; exit; end;
if TG[i]='T(9)'then begin Result:=spis_opis1(i);end;
end;
function spis_opis(var i : integer):integer;
var ErrorCode : integer;
begin
if TG[i]<>'I' then begin Result:=0; exit; end;
ErrorCode:=opis(i);
if ErrorCode<>0 then begin Result:=ErrorCode; exit; end;
Result:=spis_opis2(i);
end;
///////////////////////////////////////////////////////
function sl_ar_oper(var i : integer): integer;
var ErrorCode:integer;
virag: string;
begin
if TG[i]<>'I'then begin Result:=1; exit; end;
inc(i);
if TG[i]<>'T(14)'then begin Result:=1; exit; end;
inc(i);
while (TG[i]<>'T(9)')and(TG[i]<>'T(5)') do
begin
virag:=virag+TG[i];
inc(i);
end;
OperandToString(virag,i);
Result:=0;
end;
function ind_virag(var i : integer): integer;
var ErrorCode:integer;
virag:string;
begin
ErrorCode:=sl_ar_oper(i);
if ErrorCode<>0 then begin Result:=1; exit; end;
if TG[i]<>'T(5)'then begin Result:=1; exit; end;
inc(i);
if TG[i+1]='T(6)' then begin virag:=virag+TG[i];inc(i); end else
begin
while TG[i]<>'T(6)'do
begin
virag:=virag+TG[i];
//form1.Memo1.Lines.Add(form1.ListBox2.Items[i]);
inc(i);
end;
end;
end;
function telo(var i : integer): integer;
var ErrorCode:integer;
begin
if TG[i+1]='T(14)'then begin Result:=oper(i);exit;end;
if TG[i]<>'T(3)'then begin Result:=1; exit; end;
inc(i);
ErrorCode:=spis_oper(i);
//add
end;
function cicl(var i : integer): integer;
var ErrorCode:integer;
begin
if TG[i]<>'T(4)'then begin Result:=1; exit; end;
inc(i);
ErrorCode:=ind_virag(i);
//add
//form1.Memo1.Lines.Add(form1.ListBox1.Items[i]);
iloop:=i;
TransletPascalToAssembler('CiklBeginPice');
if TG[i]<>'T(6)'then begin Result:=1; exit; end;
inc(i);
ErrorCode:=telo(i);
iloop:=i;
TransletPascalToAssembler('CiklEndPice');
if ErrorCode<>0 then begin Result:=1; exit; end;
Result:=0;
end;
function oper(var i : integer): integer;
var ErrorCode:integer;
begin
if TG[i]='I'then begin Result:=sl_ar_oper(i); exit; end;
if TG[i]='T(4)'then begin Result:=cicl(i); exit; end;
Result:=1; exit;
end;
function spis_oper1(var i:integer):integer;
var ErrorCode:integer;
begin
if TG[i]<>'T(9)'then begin Result:=1; exit; end;
inc(i);{+}
ErrorCode:=oper(i);
if ErrorCode<>0 then begin Result:=1; exit; end;
Result:=spis_oper2(i);
end;
function spis_oper2(var i:integer):integer;
var ErrorCode:integer;
begin
if TG[i+1]='T(7)'then begin Result:=0; exit; end;
Result:=spis_oper1(i);
end;
function spis_oper(var i : integer): integer;
var ErrorCode:integer;
begin
ErrorCode:=oper(i);
if ErrorCode<>0 then begin Result:=ErrorCode; exit; end;
//add
Result:=spis_oper2(i);
end;
///////////////////////////////////////////////////////
function prog(var i : integer):integer;
var ErrorCode : integer;
begin
{'var',
'integer',
'begin',
'for',
'to',
'do',
'end',
',',
';',
'+',
'*',
'.',
':',
':='}
if TG[i]<>'T(1)' then begin Result:=1; exit; end;
inc(i);
TransletPascalToAssembler('StartPice');
ErrorCode:=spis_opis(i);
if ErrorCode<>0 then begin Result:=1; exit; end;
// TransletPascalToAssembler('PeremPice');
if TG[i]<>'T(3)' then begin Result:=1; exit; end;
inc(i);
TransletPascalToAssembler('BeginPice');
ErrorCode:=spis_oper(i);
if ErrorCode<>0 then begin Result:=1; exit; end;
inc(i);
if TG[i]<>'T(7)'then begin Result:=1; exit;end;
inc(i);
TransletPascalToAssembler('DataPice');
TransletPascalToAssembler('EndPice');
if TG[i]<>'T(12)'then begin Result:=1; exit; end;
ErrorCodeGenerate:=0;
Result:=0;
end;
////////////////////////////////////////////////
function TransletPascalToAssembler(pice : string):integer;
var buffer,bufferout,bufferout1,savebuffer,buf,LastOperation,op1 : string;
loop,i,loop3,loop4 : integer;
begin
if pice='StartPice' then
begin
Form1.Memo3.Lines.Add(';Generate Assembler Code');
Form1.Memo3.Lines.Add(';Generate Compliet by AESCompilator');
Form1.Memo3.Lines.Add(';Start Pice:');
Form1.Memo3.Lines.Add('CODE SEGMENT');
Form1.Memo3.Lines.Add('ASSUME CS:CODE,DS:CODE,SS:CODE');
Form1.Memo3.Lines.Add('ORG 100H');
end;
if pice='DataPice' then
begin
Form1.Memo3.Lines.Add(';Data Pice:');
for loop:=1 to length(SpisPerem) do
begin
if SpisPerem[loop]<>'' then
begin
Form1.Memo3.Lines.Add(SpisPerem[loop]+' db ?');
end;
end;
dec(im);
while im>=1 do
begin
Form1.Memo3.Lines.Add('M'+IntToStr(im)+' db ?');
dec(im);
end;
end;
if pice='BeginPice' then
begin
Form1.Memo3.Lines.Add(';Begin Pice:');
Form1.Memo3.Lines.Add('BEGIN:');
Form1.Memo3.Lines.Add(';Operation Pice:');
end;
if pice='Viraj1Pice' then
begin
buffer:=metka[im];
if buffer[1]='+'then begin bufferout:='add ';end;
if buffer[1]='-'then begin bufferout:='sub ';end;
if buffer[1]='*'then begin bufferout:='mul ';end;
if buffer[1]='/'then begin bufferout:='div ';end;
if im>=1 then
begin
//Form1.Memo1.Lines.Add(buffer);
//bufferout:=bufferout+metka[im][2]+metka[im][3]+metka[im][4]+metka[im][5]+metka[im][6]; //+
/////////////////////////////////////
i:=2;
while metka[im][i]<>','do
begin
inc(i);
end;
inc(i);
for loop3:=i to 5 do
begin
buf:='mov al,'+metka[im][loop3]+metka[im][loop3+1];
end;
loop3:=2;
while loop3<i do
begin
savebuffer:=savebuffer+metka[im][loop3];
inc(loop3);
end;
bufferout:=bufferout+savebuffer+'al';
form1.Memo3.Lines.Add(buf);
//++++++++++++++++++++++++++++++++++++испр mul
if (bufferout[1]='m')and(bufferout[2]='u')and(bufferout[3]='l') then
begin
loop4:=5;
while bufferout[loop4]<>','do
begin
op1:=op1+bufferout[loop4];
inc(loop4);
end;
//form1.Memo1.Lines.Add(op1);
form1.Memo3.Lines.Add('mov bl,'+op1);
form1.Memo3.Lines.Add('mul bl');
form1.Memo3.Lines.Add('mov '+op1+',ax');
//mul b,al
//form1.Memo3.Lines.Add('mov bl,b');
//form1.Memo3.Lines.Add('mul bl');
// form1.Memo3.Lines.Add('mov b,ax');
end
else
begin
form1.Memo3.Lines.Add(bufferout);
end;
//+++++++++++++++++++++++++++++++++++++++
//form1.Memo3.Lines.Add(buf);
//form1.Memo3.Lines.Add(bufferout);
buf:='';
//bufferout:='';
savebuffer:='';
////////////////////////////////////////
//form1.Memo3.Lines.Add(bufferout);
savebuffer:=bufferout;
//bufferout:='mov '+'M'+IntToStr(im)+',';
loop:=4;
while savebuffer[loop]<>','do
begin
//bufferout:=bufferout+savebuffer[loop];
inc(loop);
end;
//inc(loop);
loop3:=3;
while loop3<loop do
begin
bufferout:=savebuffer[loop3];
inc(loop3);
end;
//bufferout:=savebuffer[loop]+savebuffer[loop+1]+savebuffer[loop+2];
////////////////////////////////////////////
form1.Memo3.Lines.Add('mov al,'+bufferout);
bufferout:='mov '+'M'+IntToStr(im)+',al';
form1.Memo3.Lines.Add(bufferout);
////////////////////////////////////////////
//form1.Memo3.Lines.Add(bufferout);
bufferout:='';
savebuffer:='';
end;
end;
if pice='Viraj2Pice' then
begin
if (sim[isim-2]<>'a')or(sim[isim-2]<>'b')then
begin
Form1.Memo3.Lines.Add('mov '+'al'+','+sim[isim-1]);
Form1.Memo3.Lines.Add('mov '+sim[isim-2]+','+'al');
end
else
begin
Form1.Memo3.Lines.Add('mov '+sim[isim-2]+','+sim[isim-1]);
end;
end;
if pice='CiklBeginPice' then
begin
//Form1.Memo3.Lines.Add(';Cikl Pice');
loop:=iloop-1;
//form1.Memo1.Lines.Add(LastOperation);
while form1.ListBox2.Items[loop]<>':='do
begin
buffer:=buffer+' '+form1.ListBox2.Items[loop];
loop:=loop-1;
end;
loop:=4;
//form1.Memo1.Lines.Add(buffer[3]);
while (buffer[loop]<>'t')and(buffer[loop+1]<>'o')do
begin
bufferout1:=bufferout1+buffer[loop];
inc(loop);
end;
// form1.Memo1.Lines.Add(bufferout1);
LastOperation:=form1.Memo3.Lines[form1.Memo3.Lines.count-1];
loop:=4;
while LastOperation[loop]<>','do
begin
bufferout:=bufferout+LastOperation[loop];
inc(loop);
end;
//Form1.Memo1.Lines.Add(bufferout);
form1.Memo3.Lines.Add('mov al,'+bufferout);
form1.Memo3.Lines.Add('sub '+bufferout1+',al');
form1.Memo3.Lines.Add('mov cl,'+bufferout1);
Form1.Memo3.Lines.Add('ML:');
end;
if pice='CiklEndPice' then
begin
form1.Memo3.Lines.Add('loop ML');
end;
if pice='EndPice' then
begin
Form1.Memo3.Lines.Add(';End Pice:');
form1.Memo3.Lines.Add('CODE ENDS');
form1.Memo3.Lines.Add('END BEGIN');
end;
end;
end.
Приложение Б
Рисунок 1- Снимок окна программы