Приведенный здесь компилятор является второй модификацией компилятора, рассмотренного в
моей статье в журнале "Мир ПК" #5/2005
и отличается от него наличием параметров функций и локальных переменных,
правда реализованы они в стиле языка Фортран. Т.е. размещаются в области
глобальных переменных, но, в отличие от Фортрана, параметры передаются
по значению. Это делает исходный текст более читаемым и немного сокращает его размер.
Немного улучшенная первая модификация приведена здесь.
Следующие вещи были заимствованы:
Простые условия операторов if и while (единственное сравнение) - из PL/0
Функции без параметров - также из PL/0 (здесь уже не используется)
Массивы - можно сказать, что из Фортрана, в PL/0 массивов не было
Реализация параметров функций и локальных переменных - из Фортрана
Алгоритм компиляции - из Context'а
Функции без параметров действительно позволили реализовать очень маленький
компилятор, но они противоестественны - в математике функция без параметров
есть константа.
В Фортране параметры передаются по ссылке. Чтобы сделать возможной
передачу констант, каждой из них выделяется область память, в которую
записывается значение. Адрес этой области передается вызываемой функции
при вызове и это создает побочный эффект - функция может изменить значение
константы:
DO 10 I=1,2
CALL S(0)
10 CONTINUE
STOP
END
SUBROUTINE S(N)
901 FORMAT (1X,'N = ',I1/)
INTEGER N
WRITE(2, 901) N
N=1
END
Вывод этой программы приведен ниже и это не два нуля:
N = 0
N = 1
Передача параметров по значению избавляет от этой неприятности, но есть еще другая,
связанная с фиксированным размещением параметров и локальных переменных в памяти.
При рекурсивном вызове функции значения ее параметров и локальных переменных
могут быть изменены. Для предотвращения таких изменений используется явный стек.
Ниже приведен исходный текст компилятора. Скомпилировать его проще всего
с помощью Tiny Context 1.18 (c.118), компиляция
с помощью Context'a тоже возможна, но она потребует
трех изменений в исходном тексте:
char Temp [16640]; // Перед char Text [16384]; // Связано с различиями в использовании памяти
word Digraph(char C1, char C2) is -> word Digraph(char C1; char C2) is
word Emi3(word P, word W) is -> word Emi3(word P; word W) is
Компилируемая программа должна размещаться в файле с именем C.PRG, результат компиляции
записывается в файл C.COM. MS DOS давно устарел, но он имеет самый простой формат исполняемого
файла без заголовка и секций. Это освобождает компилятор от несущественных деталей реализации.
Если DOS недоступен, можно пользоваться DOSBox'ом:).
Использование этого компилятора в качестве начальной версии тоже возможно. Он может скомпилировать
Tiny Context до версии 1.17 включительно.
Позже компилятор был перенен на ряд других платформ, как новых, так и старых:
char Text [16384];
word pText;
word nText;
word nLine;
byte Code [16384];
word nCode;
word hFile;
char Heap [ 2048];
word nHeap;
word Name [ 256];
word Cls [ 256];
word Sub [ 256];
word Type [ 256];
word Size [ 256];
word Ofs [ 256];
word nName;
word nData;
word Stk [ 128];
word pStk;
char Buff [ 128];
word open() is
inline 0xB4, 0x3D; // mov AH, 3DH
inline 0xB0, 0x00; // mov AL, 00H
inline 0xBA, 0x4A, 0xC1; // mov DX, @@Data+Ofs(Heap[64])
inline 0xCD, 0x21; // int 21H
end
word create() is
inline 0xB4, 0x3C; // mov AH, 03CH
inline 0xB9, 0x00, 0x00; // mov CX, 00H
inline 0xBA, 0x50, 0xC1; // mov DX, @@Data+Ofs(Heap[70])
inline 0xCD, 0x21; // int 21H
end
word read() is
inline 0xB4, 0x3F; // mov AH, 3FH
inline 0x8B, 0x1E, 0x08, 0xC1; // mov BX, word [@@DATA+Ofs(hFile)]
inline 0xB9, 0x00, 0x40; // mov CX, 16384
inline 0xBA, 0x00, 0x41; // mov DX, @@DATA+Ofs(Text)
inline 0xCD, 0x21; // int 21H
end
word write() is
inline 0xB4, 0x40; // mov AH, 40H
inline 0x8B, 0x1E, 0x08, 0xC1; // mov BX, word [@@DATA+Ofs(hFile)]
inline 0x8B, 0x0E, 0x06, 0xC1; // mov CX, word [@@DATA+Ofs(nCode)]
inline 0xBA, 0x06, 0x81; // mov DX, @@DATA+Ofs(Code)
inline 0xCD, 0x21; // int 21H
end
word close() is
inline 0xB4, 0x3E; // mov AH, 3EH
inline 0x8B, 0x1E, 0x08, 0xC1; // mov BX, word [@@DATA+Ofs(hFile)]
inline 0xCD, 0x21; // int 21H
end
char putc(char C) is
char C1:=C;
inline 0x92; // xchg DX, AX
inline 0xB4, 0x02; // mov AH, 2
inline 0xCD, 0x21; // int 21H
end
word halt() is
inline 0xB8, 0x00, 0x4C; // mov AX, 4C00H
inline 0xCD, 0x21; // int 21H
end
word Init() is
Heap[ 0]:='0';
Heap[ 1]:='1';
Heap[ 2]:='2';
Heap[ 3]:='3';
Heap[ 4]:='4';
Heap[ 5]:='5';
Heap[ 6]:='6';
Heap[ 7]:='7';
Heap[ 8]:='8';
Heap[ 9]:='9';
Heap[10]:='A';
Heap[11]:='B';
Heap[12]:='C';
Heap[13]:='D';
Heap[14]:='E';
Heap[15]:='F';
Heap[16]:='c';
Heap[17]:='h';
Heap[18]:='a';
Heap[19]:='r';
Heap[20]:= char(0);
Heap[21]:='b';
Heap[22]:='y';
Heap[23]:='t';
Heap[24]:='e';
Heap[25]:= char(0);
Heap[26]:='w';
Heap[27]:='o';
Heap[28]:='r';
Heap[29]:='d';
Heap[30]:= char(0);
Heap[31]:='b';
Heap[32]:='e';
Heap[33]:='g';
Heap[34]:='i';
Heap[35]:='n';
Heap[36]:= char(0);
Heap[37]:='i';
Heap[38]:='f';
Heap[39]:= char(0);
Heap[40]:='w';
Heap[41]:='h';
Heap[42]:='i';
Heap[43]:='l';
Heap[44]:='e';
Heap[45]:= char(0);
Heap[46]:='i';
Heap[47]:='n';
Heap[48]:='l';
Heap[49]:='i';
Heap[50]:='n';
Heap[51]:='e';
Heap[52]:= char(0);
Heap[53]:='r';
Heap[54]:='e';
Heap[55]:='t';
Heap[56]:='u';
Heap[57]:='r';
Heap[58]:='n';
Heap[59]:= char(0);
Heap[60]:='e';
Heap[61]:='n';
Heap[62]:='d';
Heap[63]:= char(0);
Heap[64]:='c';
Heap[65]:='.';
Heap[66]:='p';
Heap[67]:='r';
Heap[68]:='g';
Heap[69]:= char(0);
Heap[70]:='c';
Heap[71]:='.';
Heap[72]:='c';
Heap[73]:='o';
Heap[74]:='m';
Heap[75]:= char(0);
nHeap :=76;
Name[ 0]:=16;
Cls [ 0]:= 1;
Size[ 0]:= 1;
Name[ 1]:=21;
Cls [ 1]:= 1;
Size[ 1]:= 1;
Name[ 2]:=26;
Cls [ 2]:= 1;
Size[ 2]:= 2;
nName := 3;
pStk := 0;
nCode := 0;
nData := 16640;
end
word Push(word V) is
Stk[pStk]:=V;
pStk:=pStk+1;
end
word Pop () is
pStk:=pStk-1;
return Stk[pStk];
end
word Stop() is
pStk:=0;
while nLine!=0 do
Push (nLine%10);
nLine:=nLine/10;
end
while pStk!=0 do
putc(char(Pop()+48));
end
close();
halt ();
end
word val () is
word E:=10;
word I:= 0;
if Buff[0]='0' then
if Buff[1]='x' then
E:=16;
I:= 2;
end
end
word N:=0;
while Buff[I]!=char(0) do
word K:=0;
while Heap[K]!=Buff[I] do
if K=E then
Stop();
end
K:=K+1;
end
N:=E*N;
N:=N+K;
I:=I+1;
end
return N;
end
char Look() is
if pText>=nText then
pText :=0;
nText :=read();
if pText>=nText then
return char(0);
end
end
return Text[pText];
end
char Read() is
char Ch:=Look();
if Ch =char(10) then
nLine :=nLine+1;
end
pText :=pText+1;
return Ch;
end
word isalnum() is
if 'A'<=Look() then
if Look()<='Z' then
return 0;
end
end
if 'a'<=Look() then
if Look()<='z' then
return 0;
end
end
if '0'<=Look() then
if Look()<='9' then
return 0;
end
end
return 1;
end
word Digraph(char C1, char C2) is
if Buff[0]=C1 then
if Look()=C2 then
Buff[1]:=Read();
Buff[2]:=char(0);
end
end
end
char Scan() is
word pBuff:=0;
while pBuff =0 do
word sFlag:=0;
while sFlag =0 do
if Look()!=char( 9) then
if Look()!=char(10) then
if Look()!=char(13) then
if Look()!=char(32) then
sFlag:=1;
end
end
end
end
if sFlag=0 then
Read();
end
end
while isalnum()=0 do
Buff[pBuff]:= Read();
pBuff :=pBuff+1;
end
if pBuff=0 then
Buff[pBuff]:= Read();
pBuff :=pBuff+1;
end
Buff[pBuff] :=char(0);
Digraph('<', '=');
Digraph('!', '=');
Digraph('>', '=');
Digraph(':', '=');
if Buff[0]='/' then
if Look()='/' then
while Look()!=char(10) do
if Read()=char(0) then
Stop();
end
end
pBuff:=0;
end
end
end
end
word Comp(word pHeap) is
word pBuff:=0;
while Buff[pBuff]=Heap[pHeap] do
if Buff[pBuff]=char(0) then
return 0;
end
pHeap:=pHeap+1;
pBuff:=pBuff+1;
end
return 1;
end
word Find(word fFlag) is
word pName:=0;
while pName< nName do
if Comp(Name[pName])=0 then
return pName;
end
pName:=pName+1;
end
if fFlag=0 then
Stop();
end
return pName;
end
byte Emi1(byte B) is
Code[nCode]:=B;
nCode:=nCode+1;
end
word Emi2(word W) is
Emi1(W%256);
Emi1(W/256);
end
word Emi3(word P, word W) is
W:=W-3;
Code[P] :=W%256;
Code[P+1]:=W/256;
end
word Assign(word I) is
if Size[I]>1 then
Emi1(0x5B); // pop BX
end
byte B:=0x89; // mov [(BX+)Ofs], AX
if Size[Type[I]]=1 then
B:=0x88; // mov [(BX+)Ofs], AL
end
Emi1(B);
B:=0x06; // [Ofs]
if Size[I]>1 then
B:=0x87; // [BX+Ofs]
end
Emi1(B);
Emi2(Ofs[I]);
end
word Expr() is
word eFlag:=0;
//if eFlag =0 then
if '0'<=Buff[0] then
if Buff[0]<='9' then
Emi1(0xB8); // mov AX, Val
Emi2(val());
eFlag:=1;
end
end
if Buff[0]=''' then
Emi1(0xB8); // mov AX, Val
Emi2(word(Read()));
Read();
eFlag:=1;
end
if Buff[0]='(' then
Scan();
Expr();
eFlag:=1;
end
//end
if eFlag =0 then
word I:=Find(0);
if Cls[I]=1 then
Push(I);
Scan(); // (
Scan();
Expr();
I:=Pop();
end
if Cls[I]=2 then
if Size[I]>1 then
Push(I);
Scan(); // [
Scan();
Expr();
I:=Pop();
if Size[Type[I]]=2 then
Emi1(0xD1); // shl AX, 1
Emi1(0xE0);
end
Emi1(0x93); // xchg BX, AX
end
byte B:=0x8B; // mov AX, [(BX+)Ofs]
if Size[Type[I]]=1 then
Emi1(0x32); // xor AH, AH
Emi1(0xE4);
B:=0x8A; // mov AL, [(BX+)Ofs]
end
Emi1(B);
B:=0x06; // [Ofs]
if Size[I]>1 then
B:=0x87; // [BX+Ofs]
end
Emi1(B);
Emi2(Ofs[I]);
end
if Cls[I]=3 then
Scan(); // (
Push(I);
Sub[nName]:= 0;
word J:=I+1;
while Sub[J]=1 do
Push(J);
Scan();
Expr();
J:=Pop();
Assign(J);
J:=J+1;
end
I:=Pop();
if J=I+1 then
Scan(); // )
end
word W:=(0xFFFF-((nCode+3)-Ofs[I]))+1;
Emi1(0xE8); // call Ofs
Emi2(W);
end
end
Scan();
word I:=0;
if Buff[0]='+' then
I:=1;
end
if Buff[0]='-' then
I:=2;
end
if Buff[0]='*' then
I:=3;
end
if Buff[0]='/' then
I:=4;
end
if Buff[0]='%' then
I:=5;
end
if I!=0 then
Emi1(0x50); // push AX
Push(I);
Scan();
Expr();
I:=Pop();
Emi1(0x5B); // pop BX
if I =1 then
Emi1(0x03); // add AX, BX
Emi1(0xC3);
end
if I =2 then
Emi1(0x93); // xchg BX, AX
Emi1(0x2B); // sub AX, BX
Emi1(0xC3);
end
if I =3 then
Emi1(0xF7); // mul BX
Emi1(0xE3);
end
if I>=4 then
Emi1(0x93); // xchg BX, AX
Emi1(0x33); // xor DX, DX
Emi1(0xD2);
Emi1(0xF7); // div BX
Emi1(0xF3);
end
if I =5 then
Emi1(0x92); // xchg DX, AX
end
end
end
word Cond() is
Scan();
Expr();
word jCode:=0;
if Buff[0]='<' then
jCode:=0x72; // jb Ofs
if Buff[1]='=' then
jCode:=0x76; // jbe Ofs
end
end
if Buff[0]='=' then
jCode:=0x74; // je Ofs
end
if Buff[0]='!' then
jCode:=0x75; // jne Ofs
end
if Buff[0]='>' then
jCode:=0x77; // ja Ofs
if Buff[1]='=' then
jCode:=0x73; // jae Ofs
end
end
if jCode=0 then
Stop();
end
Emi1(0x50); // push AX
Scan();
Expr();
Emi1(0x5B); // pop BX
Emi1(0x3B); // cmp BX, AX
Emi1(0xD8);
Emi1(jCode); // jxx Ofs
Emi1(0x03);
Push(nCode);
Emi1(0xE9); // jmp ?
nCode:=nCode+2;
end
word Obj (word T) is
if Cls[T]!=1 then
Stop();
end
Name[nName]:=nHeap;
Type[nName]:= T;
Scan();
if Find(1)<nName then
Stop();
end
word pBuff:=0;
char Ch :=char(1);
while Ch !=char(0) do
Ch := Buff[pBuff];
Heap[nHeap]:= Ch;
nHeap :=nHeap+1;
pBuff :=pBuff+1;
end
Scan();
return nName;
end
char Var (word Subclass) is
Cls [nName]:= 2;
Sub [nName]:= Subclass;
Size[nName]:= 1;
Ofs [nName]:=nData;
if Buff[0]='[' then
if Subclass!=0 then
Stop();
end
Scan();
Size[nName]:=val();
Scan(); // ]
Scan(); // ;
end
nData :=nData+(Size[Type[nName]]*Size[nName]);
if nData%2!=0 then
nData :=nData+1;
end
nName :=nName+1;
return Buff[0];
end
word Hide() is
word I:=Pop();
while I< nName do
Heap[Name[I]]:=char(0);
I :=I+1;
end
end
word rFlag;
word Ctrl() is
word cFlag:=0;
//if cFlag =0 then
if Comp(37)=0 then // if
Cond();
Push(nName);
Scan();
Ctrl();
while Comp(60)!=0 do // !end
Ctrl();
end
Hide();
word pSkip:=Pop();
Emi3(pSkip+1, nCode-pSkip);
rFlag:=1; // 14.05.2006
cFlag:=1;
end
//end
if cFlag =0 then
if Comp(40)=0 then // while
Push(nCode);
Cond();
Push(nName);
Scan();
Ctrl();
while Comp(60)!=0 do // !end
Ctrl();
end
Hide();
word pExit:=Pop();
word pLoop:=Pop();
Emi1(0xE9); // jmp Ofs
Emi2((0xFFFF-((nCode+2)-pLoop))+1);
Emi3(pExit+1, nCode-pExit);
rFlag:=1; // 14.05.2006
cFlag:=1;
end
end
if cFlag =0 then
if Comp(46)=0 then // inline
Buff[0]:=',';
while Buff[0]=',' do
Scan();
Emi1(val()); // db Val
Scan();
end
rFlag:=1; // 14.05.2006
cFlag:=1;
end
end
if cFlag =0 then
if Comp(53)=0 then // return
Scan();
Expr();
Emi1(0xC3); // retn
rFlag:=0; // 14.05.2006
cFlag:=1;
end
end
if cFlag =0 then
word I:=Find(0);
if Cls[I]=1 then
word N:=Obj(I);
if Var(2)=':' then
Scan();
Expr();
Assign(N);
end
end
if Cls[I]=2 then
if Size[I]>1 then
Scan(); // [
Scan();
Expr();
if Size[Type[I]]=2 then
Emi1(0xD1); // shl AX, 1
Emi1(0xE0);
end
Emi1(0x50); // push AX
end
Scan(); // :=
Scan();
Expr();
Assign(I);
end
if Cls[I]=3 then
Expr();
end
rFlag:=1; // 14.05.2006
end
Scan();
end
word Func() is
Scan();
Ctrl();
while Comp(60)!=0 do // !end
Ctrl();
end
if rFlag!=0 then // 14.05.2006 // if rFlag=0 then
Emi1(0xC3); // retn
end
end
begin
Init();
hFile:=open();
pText:=0;
nText:=0;
nLine:=1;
Emi1(0xE9); // jmp ?
nCode:=nCode+2;
Scan();
while Comp(31)!=0 do // !begin
Obj (Find(0));
char Ch:=Buff[0];
if Ch ='(' then
Cls [nName]:= 3;
Sub [nName]:= 0;
Ofs [nName]:=nCode;
nName :=nName+1;
Push(nName);
Scan();
if Buff[0]!=')' then
Obj (Find(0));
while Var(1)=',' do
Scan();
Obj (Find(0));
end
end
Scan(); // is
Func();
Hide();
end
if Ch!='(' then
Var(0);
end
Scan();
end
Emi3 (1, nCode);
Func ();
close();
hFile:=create();
write();
close();
end