{GetExtent(r);}

r.a.y:=r.b.y+1;

StatusLine:=New(PStatusLine,Init(r,

NewStatusDef(0,$ffff,

NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,

NewStatusKey('~Alt-F4~ New', kbF4, cmNewWin,

NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,

NewStatusKey( '',kbF10, cmMenu,

nil)))),

nil)));

end;

procedure TMyApp.InitMenuBar;

var r:TRect;

begin

GetExtent(r);

r.b.y:=r.a.y+1;

MenuBar:=New(PMenuBar, Init(r, NewMenu(

NewSubMenu('~F~ile', hcNoContext, NewMenu(

NewItem('~O~pen', 'F3',kbF3,cmFileOpen, hcNoContext,

NewItem('~N~ew', 'F4',kbF4,cmNewWin, hcNoContext,

NewLine(

NewItem('E~x~it', 'Alt-x', kbAltX, cmQuit, hcNoContext,

nil))))),

NewSubMenu('~W~indow', hcNoContext, NewMenu(

NewItem('~N~ext', 'F6',kbF6,cmNext, hcNoContext,

NewItem('~Z~oom', 'F5',kbF5,cmZoom, hcNoContext,

nil))),

NewSubMenu('~C~ompile', hcNoContext, NewMenu(

NewItem('~C~ompile','Alt-F9',kbAltF9,cmCompile,hcNoContext,

nil)),

nil

))))));end;

procedure TMyApp.NewWindow;

var Window:PM13Window;

r:TRect;

i:integer;

begin

i:=0;

inc(WinCount);

r.assign(0,0,80,23-wincount+1);

r.move(0,i+wincount-1);

window:=new(pM13window, init(r, 'Compile window', wincount));

desktop^.insert(window);

end;

procedure TMyApp.NewDialog;

var

Dialog:PDialog;

R:TRect;

control:Word;

B:PView;

Window:PM13Window;

i:integer;

f:text;

s:string;

begin

R.Assign(20,6,60,19);

Dialog:=New(PDialog,Init(R,'M13 Dialog'));

with Dialog^ do

begin

R.Assign(15,10,25,12);

Insert(New(PButton,Init(R,'~O~K',cmOK,bfDefault)));

R.Assign(28,10,38,12);

Insert(New(PButton,Init(R,'Cancel',cmCancel,bfNormal)));

R.Assign(3,8,37,9);

B:=New(PInputLine,Init(r,128));

insert(b);

R.Assign(2,7,24,8);

insert(New(PLabel,Init(R,'Delivery instructions',B)));

end;

Dialog^.SetData(M13DialogData);

Control:=DeskTop^.ExecView(Dialog);

if Control<>cmCancel then Dialog^.GetData(M13DialogData);

i:=0;

while M13DialogData.InputLineData[i]<>'.' do

begin

s[i]:=M13DialogData.InputLineData[i];

i:=i+1;

end;

s[i]:=M13DialogData.InputLineData[i];

s[i+1]:=M13DialogData.InputLineData[i+1];

s[i+2]:=M13DialogData.InputLineData[i+2];

s[i+3]:=M13DialogData.InputLineData[i+3];

s1:=s;

LineCount:=0;

Assign(F,s);

reset(F);

while not Eof(F) and (LineCount<MaxLines)do

begin

readln(f,s);

lines[linecount]:=newstr(s);

inc(linecount);

{writeln(lines[linecount]^);}

end;

close(F);

i:=0;

inc(WinCount);

r.assign(0,0,80,23-wincount+1);

r.move(0,i+wincount-1);

window:=new(pM13window, init(r, s1, wincount));

desktop^.insert(window);

end;

function vuraz(var s:char):integer;

var

w:integer;

begin

if ((integer(s)>=97)and(integer(s)<=122))or((integer(s)>=65)and(integer(s)<=90))

then vuraz:=30

else vuraz:=29;

end;

procedure Compiles;

label aa;

var a1:array [1..100] of MyStruct;

i,j,j1,k,kk,i1,i2,var_kil,begin_kil,end_kil,var_index,begin_index,end_index:integer;

q,q1:string;

ss:array [1..50] of string[50];

f1,f2,f3,f4:text;

ch,ch1:char;

mn:string;

m,nerivne,m1,pa:integer;

begin

assign(f1,s1);

reset(f1);

i:=0;j:=0;

while s1[i]<>'.' do

begin

q[j]:=s1[i];q1[i]:=s1[i];

i:=i+1;j:=j+1;

end;

q[j]:=s1[i];j:=j+1;q[j]:='t';j:=j+1;q[j]:='x';j:=j+1;q[j]:='t';

q1[i]:=s1[i];q1[i+1]:='a';q1[i+2]:='s';q1[i+3]:='m';

for i:=1 to 100 do

a1[i].b:=0;

i1:=1;

assign(f2,q);

Rewrite(f2);

assign(f3,q1);

rewrite(f3);

j1:=1;k:=0;i:=1;

j:=1;

while not EOF(f1) do

begin

readln(f1,ss[j]);

a1[i].c[1]:=ss[j][1];j1:=2;ch1:=ss[j][1];

i2:=2;

while ss[j][i2]<>#0 do

begin

if (ss[j][i2]=' ')or(ss[j][i2]=';')or(ss[j][i2]='+')or(ss[j][i2]='-')or(ss[j][i2]='*')

or (ss[j][i2]='.')or(ss[j][i2]='/')or(ss[j][i2]=')')or(ss[j][i2]='(')or(ss[j][i2]=',')or(ss[j][i2]=':')

or(ss[j][i2]='=')or(ss[j][i2]='>')or(ss[j][i2]='<')or((ss[j][i2]='<')and(ss[j][i2]='>'))

or ((ss[j][i2]='=')and(ss[j][i2]='='))or(ss[j][i2]='^')

then begin

if (ch1=' ')or(ch1=';')or(ch1='+')or(ch1='-')or(ch1='*')

or (ch1='.')or(ch1='/')or(ch1=')')or(ch1='(')or(ch1=',')or(ch1=':')or(ch1='=')

or(ch1='>')or(ch1='<')or((ch1='<')and(ch1='>'))

or ((ch1='=')and(ch1='='))or(ch1='^')

then begin i:=i+1;end

else begin a1[i].c[j1]:=#0;i:=i+1;end;

ch1:=ss[j][i2];

a1[i].c[1]:=ss[j][i2];a1[i].c[2]:=#0;i:=i+1;j1:=1;

end

else begin a1[i].c[j1]:=ss[j][i2];j1:=j1+1;ch1:=ss[j][i2];end;

i2:=i2+1;

end;

j:=j+1;

end;

k:=i-1;

for i:=1 to k do

begin

if ((a1[i].c[1]='p')and( a1[i].c[2]='r')and( a1[i].c[3]='o')and( a1[i].c[4]='g')

and( a1[i].c[5]='r')and( a1[i].c[6]='a')and( a1[i].c[7]='m'))then a1[i].b:=1;

if (( a1[i].c[1]='v')and( a1[i].c[2]='a')and( a1[i].c[3]='r'))then a1[i].b:=2;

if (( a1[i].c[1]='b')and( a1[i].c[2]='y')and( a1[i].c[3]='t')and( a1[i].c[4]='e'))then a1[i].b:=3;

if (( a1[i].c[1]='c')and( a1[i].c[2]='h')and( a1[i].c[3]='a')and( a1[i].c[4]='r'))then a1[i].b:=4;

if (( a1[i].c[1]='b')and( a1[i].c[2]='o')and( a1[i].c[3]='o')and( a1[i].c[4]='l')

and( a1[i].c[5]='e')and( a1[i].c[6]='a')and( a1[i].c[7]='n'))then a1[i].b:=5;

if (( a1[i].c[1]='b')and( a1[i].c[2]='e')and( a1[i].c[3]='g')and( a1[i].c[4]='i')

and( a1[i].c[5]='n'))then a1[i].b:=7;

if (( a1[i].c[1]='w')and( a1[i].c[2]='r')and( a1[i].c[3]='i')and( a1[i].c[4]='t')

and( a1[i].c[5]='e')and( a1[i].c[6]='l')and( a1[i].c[7]='n'))then a1[i].b:=8;

if (( a1[i].c[1]='r')and( a1[i].c[2]='e')and( a1[i].c[3]='a')and( a1[i].c[4]='d')

and( a1[i].c[5]='l')and( a1[i].c[6]='n'))then a1[i].b:=9;

if (( a1[i].c[1]='e')and( a1[i].c[2]='n')and( a1[i].c[3]='d'))then a1[i].b:=15;

if (a1[i].c[1]=';')then a1[i].b:=16;

if (a1[i].c[1]=',')then a1[i].b:=17;

if (a1[i].c[1]='(')then a1[i].b:=18;

if (a1[i].c[1]=')')then a1[i].b:=19;

if (a1[i].c[1]='*')then a1[i].b:=20;

if (a1[i].c[1]='+')then a1[i].b:=21;

if (a1[i].c[1]='-')then a1[i].b:=22;

if (a1[i].c[1]='/')then a1[i].b:=23;

if (a1[i].c[1]=' ')then a1[i].b:=24;

if (a1[i].c[1]='\n')then a1[i].b:=25;

if (a1[i].c[1]=':')then a1[i].b:=26;

if (a1[i].c[1]='=')then a1[i].b:=27;

if (a1[i].c[1]='.')then a1[i].b:=28;

if (a1[i].c[1]='>')then a1[i].b:=29;

if (a1[i].c[1]='<')then a1[i].b:=30;

if ((a1[i].c[1]='!')and(a1[i].c[1]='=')) then a1[i].b:=31;

if ((a1[i].c[1]='=')and(a1[i].c[1]='=')) then a1[i].b:=32;

if (a1[i].c[1]='^')then a1[i].b:=33;

if (( a1[i].c[1]='N')and( a1[i].c[2]='O')

and( a1[i].c[3]='T'))then a1[i].b:=34;

end;

for i:=0 to k do

if a1[i].b=0 then a1[i].b:=vuraz(a1[i].c[1]);

var_kil:=0;begin_kil:=0;end_kil:=0;

for i:=1 to k do

begin

if a1[i].b=2 then var_kil:=var_kil+1;

if a1[i].b=7 then begin_kil:=begin_kil+1;

if a1[i].b=15 then end_kil:=end_kil+1;

end;

for i:=1 to k do

begin

writeln(f2,a1[i].b);

end;

if var_kil>1 then writeln(f2,'Error 1: Декiлька разiв вiдбуваеться опис даних');

if begin_kil>1 then writeln(f2,'Error 2: Декiлька разiв введено слово begin');

if end_kil>1 then writeln(f2,'Error 3: Декiлька разiв введено слово end');

if var_kil=0 then writeln(f2,'Error 4: Немає опису даних');

if begin_kil=0 then writeln(f2,'Error 5: Немає початку тiла програми');

if end_kil=0 then writeln(f2,'Error 6: Немає кiнця тiла програми');

if nevid=0 then writeln(f2,'Error 18: Невідома змінна:',k);

var_index:=0;begin_index:=0;end_index:=0;

for i:=1 to k do

begin

if a1[i].b=2 then var_index:=i;

if a1[i].b=7 then begin_index:=i;

if a1[i].b=15 then end_index:=i;

end;

for i:=var_index to begin_index do

begin

if a1[i].b=3 then begin if a1[i-1].b<>26 then

writeln(f2,'Error 7: Пропущено- : при описi змiнних типу Byte');

j:=i-2;

while a1[j].b<>16 do

begin

if a1[j].b=30 then a1[j].b:=35;

j:=j-1;

end;

if a1[i].b=4 then begin if a1[i-1].b<>26then

writeln(f2,'Error 7: Пропущено- : при описi змiнних типу Char');

j:=i-2;

while a1[j].b<>26 do

begin

if a1[j].b=30 then a1[j].b:=36;

j:=j-1;

end;

if a1[i].b=5 then begin if a1[i-1].b<>16then

writeln(f2,'Error 7: Пропущено- : при описi змiнних типу Boolean');

j:=i-2;

while a1[j].b<>16 do

begin

if a1[j].b=30 then a1[j].b:=37;

j:=j-1;

end;

assign(f4,'1.M13');

reset(f4);

readln(f4,mn);

writeln(f3,'ideal');

writeln(f3,'model small');

writeln(f3,'stack 256');

writeln(f3,'dataseg');

writeln(f3,'perkur db ',mn,'$',mn);

writeln(f3,'TrueStr db ',mn,'TRUE$',mn);

writeln(f3,'FalseStr db ',mn,'False$',mn);

writeln(f3,'InString db 255 DUP(?)');

writeln(f3,'OutString db 255 DUP(?)');

writeln(f3,'CharStr db 2,5 DUP(?)');

writeln(f3,'len dw ?');

for i:=var_index+1 to begin_index do

begin

if a1[i].b=31 then begin j:=1;

while a1[i].c[j]<>#0 do

begin

write(f3,a1[i].c[j]);

j:=j+1;

end;

writeln(f3,' dw ?');

end;

if a1[i].b=32 then begin j:=1;

while a1[i].c[j]<>#0 do

begin

write(f3,a1[i].c[j]);

j:=j+1;

end;

writeln(f3,' db ?');

end;

if a1[i].b=33 then begin j:=1;

while a1[i].c[j]<>#0 do

begin

write(f3,a1[i].c[j]);

j:=j+1;

end;

writeln(f3,' db ?');

end;

writeln(f3,'codeseg');

writeln(f3,'start:');

writeln(f3,'mov ax,@data');

writeln(f3,'mov ds,ax');

i:=begin_index+1;

while i<>end_index do

begin

kk:=i;

if a1[i].b=8

then

begin

if (a1[i+1].b<>18)then writeln(f2,'Error: Пропущено ( при написаннi функцii writeln');

kk:=i+2;

while a1[kk].b<>19 do

begin

if (a1[kk].b<>17) or (a1[kk].b<>19) then

begin

for j:=var_index+1 to begin_index do

begin

if (copy(a1[kk].c,1,a1[kk].b1))=(copy(a1[j].c,1,a1[j].b1))

then a1[kk].b:=a1[j].b;

end;

writeln(a1[kk].b);

if a1[kk].b=31 then

begin

writeln(f3,'mov ax,[',copy(a1[kk].c,1,a1[kk].b1),']');

writeln(f3,'call WriteByte');

end;

if a1[kk].b=32 then

begin

writeln(f3,'mov al,[',copy(a1[kk].c,1,a1[kk].b1),']');

writeln(f3,'call WriteChar');

end;

if a1[kk].b=33 then

begin

writeln(f3,'mov al,[',copy(a1[kk].c,1,a1[kk].b1),']');

writeln(f3,'call WriteBool');

end;

kk:=kk+1;

end;

if a1[kk+1].b<>16 then if a1[kk+2].b<>16 then

writeln(f2,'Error: Пропущено ; пiсля операцii writeln');

end;

if a1[i].b=9

then

begin

if (a1[i+1].b<>18)then writeln(f2,'Error: Пропущено ( при написаннi функцii writeln');

kk:=i+2;while a1[kk].b<>19 do

begin

if a1[kk].b<>17 then

begin

m:=0;while a1[kk].c[m]<>#0 do

m:=m+1;

for j:=var_index+1 to begin_index do

begin

nerivne:=0;m1:=0;

while m1<>m do

begin

if a1[kk].c[m1]=a1[j].c[m1] then nerivne:=nerivne+1;

m1:=m1+1

end;

if nerivne=m then a1[kk].b:=a1[j].b;

end;

if a1[kk].b=31 then

begin

writeln(f3,'call ReadInt');

writeln(f3,'mov [',a1[kk].c,'],ax');

end;

if a1[kk].b=32 then

begin

writeln(f3,'call ReadChar');

writeln(f3,'mov [',a1[kk].c,'],al');

end;

if a1[kk].b=33 then

begin

writeln(f3,'call ReadBool');

writeln(f3,'mov [',a1[kk].c,'],al');

end;

kk:=kk+1;

end;

if a1[kk+1].b<>16 then if a1[kk+2].b<>16 then

writeln(f2,'Error 15: Пропущено ; пiсля операцii writeln');

end;

{if a1[i].b=30 then pa:=assign(a1,i);}

i:=kk+1;

end;

close(f3);

close(f2);

close(f1);

writeln('Кiнець');

end;

procedure TMyApp.HandleEvent(var Event:TEvent);

begin

TApplication.HandleEvent(Event);

if Event.What=evCommand then

begin

case Event.Command of

cmNewWin:NewWindow;

cmFileOpen:NewDialog;

cmCompile:Compiles;

else

Exit;

end;

ClearEvent(Event);

end;

constructor TInterior.Init(var Bounds:TRect;AHScrollBar,

AVScrollBar:PScrollBar);

begin

TScroller.Init(Bounds,AHScrollBar,AVScrollBar);

GrowMode:=gfGrowHiX+gfGrowHiY;

SetLimit(128,LineCount);

end;

procedure TInterior.Draw;

var i,y:integer;

Color:Byte;

B:TDrawBuffer;

begin

Color:=GetColor(1);

for y:=0 to size.y-1 do

begin

MoveChar(B,' ',Color,Size.x);

i:=Delta.Y+y;

if (i<LineCount) and (Lines[i]<>nil) then

MoveStr(B,Copy(Lines[i]^,Delta.x+1,Size.x),Color);

writeLine(0,y,Size.x,1,b);

end;

procedure ReadFile;

var

F:Text;

S:String;

begin

LineCount:=0;

Assign(F,'Test.M13');

reset(F);

while not Eof(F) and (LineCount<MaxLines)do

begin

readln(f,s);

lines[linecount]:=newstr(s);

inc(linecount);

{writeln(lines[linecount]^);}

end;

close(F);

end;

procedure TM13Window.MakeInterior(Bounds:Trect);

var

HScrollBar,VScrollBar:PScrollBar;

interior:PInterior;

R:TRect;

begin

VScrollBar:=StandardScrollBar(sbVertical+sbHandleKeyboard);

HScrollBar:=StandardScrollBar(sbHorizontal+sbHandleKeyboard);

Interior:=New(PInterior,Init(Bounds,HScrollBar,VScrollBar));

Insert(Interior);

end;

constructor TM13Window.Init(Bounds:TRect;

WinTitle:string;WindowNo:Word);

var s:string[3];

begin

str(WindowNo, s);

TWindow.Init(Bounds, WinTitle+' '+s, wnNoNumber);

GetExtent(Bounds);

Bounds.Grow(-1,-1);

MakeInterior(Bounds);

end;

procedure DoneFile;

var

i:integer;

begin

for i:=0 to linecount-1 do

if lines[i]<>nil then disposestr(lines[i]);

end;

var MyApp:TMyApp;

begin

MyApp.Init;

MyApp.Run;

MyApp.Done;

end.

Додаток Б

Тестова програма на мові M13 з лексичною помилкою:

'Error 13: Невідомий символ: BegAn '

program ja;

var a:byte;

begАn

a:=13;

writeln ('Varian :', a);

end.

Тестова програма на мові M13 з синтаксичною помилкою:

Error15: Пропущено ; пiсля операцii writeln'

program ja;

var a:byte;

begin

a:=13;

writeln ('Varian :', a)

end.

Тестова програма на мові M13 з семантичною помилкою:

'Error 18: Пропущено змінну: b'

program ja;

var a,c:byte;

begАn

a:=53;

b:=13;

c:=a+b;

writeln ('Varian :', b)

end.

Тестова програма на мові M13 без помилок:

program ja;

var a:byte;

begin

b:=13;

writeln ('Varian :', b);

end.

Рисунок 6 Вигляд працездатного компілятора.

Розробка компілятора з вхідної мови програмування (стр. 5 из 5)

Додаток Б