Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
6
Добавлен:
07.08.2013
Размер:
164.86 Кб
Скачать

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- Снимок окна программы

Соседние файлы в папке Курсач