О проектировании компиляторов написаны книги. Нижеследующий текст их не заменит,
но, надеюсь, позволит получить элементарное представление об устройстве
компиляторов. Когда я решил написать компилятор, я пытался сразу реализовать
довольно много возможностей, заметно больше, чем нужно для написания самого
компилятора. Это удалось, но получившийся компилятор содержит много деталей,
затрудняющих его понимание. Часть деталей связана с возможностями языка, другая
часть - с процессором 8086 (80386 удобнее, но тогда я этого не знал, да и
32-х разрядные операционные системы еще не распространились). И конечно, многое
можно было сделать лучше. В какой-то момент я уменьшил компилятор, но совсем
маленьким он не стал. Значительно уменьшить компилятор можно за счет упрощения
входного языка, что здесь и сделано. Приведенный здесь игрушечный компилятор
для практических целей непригоден, но он построен так же, как и настоящий...
Пpогpамма на языке ассемблеpа - это пpосто последовательность инстpукций, каждая
из котоpых пpеобpазуется в один или несколько байт кода, причем код большинства
инструкций не зависит от окружения и может быть получен немедленно. Пpогpамма
на языке высокого уровня имеет более сложную структуру и ее преобразование
в машинный код сложнее. Во-пеpвых, программа может содеpжать объявления новых
типов, пеpеменных и заголовков функций, котоpые не пpеобpазуются в код, но
используются пpи его создании. Во-втоpых, программа может вообще не содеpжать
меток и опеpатоpов пеpехода, вместо них используются несколько стpуктуpных
опеpатоpов. В тpетьих, программа может содеpжать сколь угодно сложные выpажения.
Как и ассемблерный листинг, программа на любом языке высокого уровня состоит из
слов (зарезервированных слов языка, идентификаторов, чисел, знаков) и для выделения
их из текста может быть использована функция Scan, похожая на одноименную функцию
ассемблеpа. В ней есть лишь два отличия - она должна также выделять из текста
многосимвольные опеpатоpы (в языке Context это <= - меньше или pавно, != - не
pавно и >= - больше или pавно) и пропускать многострочные комментарии
(в ассемблере комментарии были только однострочные). В целях упрощения от
комментариев можно было бы отказаться, но промышленный компилятор должен их
поддерживать. Сканер зависит от входного языка, сканер Fortran'а, например,
должен выделять слова .or. (логическое или) и .and. (логическое и), сканер
рассмотренного выше ассемблера посчитает любое из них тремя словами. Впрочем,
это не самая большая проблема сканера Fortran'а. Иногда приводится следующий
пример:
901 FORMAT (1X,'N = ',I2/)
N=0
10 DO 20 I=1.5
N=N+1
20 CONTINUE
WRITE(6,901) N
STOP
END
Заголовок цикла в строке с меткой 10 содержит опечатку (точка вместо запятой,
на клавиатуре они рядом), но Fortran посчитает, что это присваивание константы
1.5 переменной с именем DO20I. Соответственно, на печать будет будет выведено
число 1, а не 5.
Не только сканер, но и компилятор в целом зависит от входного языка, поэтому
лучше перейти к частному и рассмотреть конкретный язык - Context.
Программа на языке Context представляет собой последовательность определений:
констант
типов (структур)
глобальных переменных
функций
их взаимное расположение в программе ограничено только одним условием - каждый
объект должен быть определен до его использования, завершает программу главная
функция. Для некоторых объектов, например, функций достаточно лишь объявнения,
но в минимальной версии это не будет реализовано.
Определения константы, структуры и главной функции распознаетмся по первому
слову (define, struct и begin соответственно), определения функции и глобальной
переменной начинаются с имени типа и друг от друга отличаются наличием и отсутствием
круглой скобки после имени. Т.е. после имени типа надо прочиталь символы @ (если они
есть), само имя и следующее за ним слово. Если это слово - круглая скобка, то
должен выполняться разбор функции, иначе - разбор глобальной переменной. В других
языках функция определяется по первому слову, в Pascal'е, например, функция
начинается со слова function, а список переменных со слова var.
Таким образом, на верхнем уровне компилятор может состоять из простого цикла:
while TRUE do
Scan(@Buff);
select
case strcmp(@Buff,"begin") =0:
// Разбор главной функции
exit
case strcmp(@Buff,"define")=0:
// Разбор константы
case strcmp(@Buff,"struct")=0:
// Разбор структуры
default:
// Разбор глобальной переменной или функции
end
end
Разумеется, каждая из ветвей select'а должна содержать определенный код.
Разбор констант и структур достаточно прост (тем более, в Context'е структуры
нерекурсивны - в отличие от Pascal их определения не могут быть вложенными),
результатом разбора являются новые записи в таблице глобальных имен, никакого
кода не создается. Разбор функций сложнее. Он состоит из разбора заголовка
со списком параметров (что очень похоже на разбор структуры) и разбора входящих
в функцию операторов. Если написана функция Ctrl, компилирующая один оператор,
компиляция всей функции сводится к циклу из трех строк:
while strcmp(@Scan(@Buff),"end")!=0 do
Ctrl(@Buff);
end
Для дальнейшего, однако, нужно изменить этот цикл и функцию Ctrl:
//Scan(@Buff);
while strcmp(@Buff,"end")!=0 do
Ctrl(@Buff); // Ctrl должна считывать следующее за оператором слово
end
Такое изменение позволит выполнить разбор функции расширенной версии Context'а,
допускающей объявления заголовков функций (аналог в Pascal - forward):
word F();
word G()
F();
end
После закрывающей скобки может встретиться точка с запятой (F) или начало первого
оператора функции (G). После считывания закрывающей скобки необходимо считать
следующее слово и, если это не точка с запятой, запомнить его и перейти к
компиляции операторов, второй вариант цикла приспособлен для этого. За счет
изменения языка можно восстановить работоспособность первого варианта:
word F();
word G() is
F();
end
Здесь после закрывающей скобки всегда есть слово (точка с запятой или is).
Все операторы, которые могут встретиться в функции, распознаются по первому
слову, поэтому на верхнем уровне Ctrl может быть устроена так:
void Ctrl(char @Buff)
select
case strcmp(@Buff,"if")=0 | strcmp(@Buff,"select")=0:
// разбор условного оператора
case strcmp(@Buff,"while")=0:
// разбор цикла
case strcmp(@Buff,"loop")=0:
// разбор loop
case strcmp(@Buff,"exit")=0:
// разбор exit
case strcmp(@Buff,"inc")=0:
// разбор inc
case strcmp(@Buff,"dec")=0:
// разбор dec
default:
// Разбор объявления локальной переменной или присваивания
end
Scan(Buff);
end
Большинство операторов содержат выражения, их компиляция - наиболее сложная задача,
но она может быть решена аналогично задаче вычисления выражения. Пока отложим ее и
будем считать, что уже написана функция Expr, компилирующая любое выражение и
возвращающая тип и адрес результата (это может быть адрес памяти, регистр или
ссылка на элемент таблицы констант).
С помощью функции Expr разбор цикла while может быть выполнен так:
// Генеpация кода @A: nop; начало цикла
// Вызов функции Expr,
// загpузка pезультата в AL
// Генеpация кода or AL,AL
// jnz @B
// jmp ?
// @B: nop
while strcmp(@Buff,"end")!=0 do
Ctrl(@Buff);
end
// Генеpация кода jmp @A
@C: nop
// Корректировка перехода jmp ? (jmp @C)
Это не все необходимые действия, еще нужно выполнить подготовку к компиляции
операторов loop/exit и к разбору определенных внутри цикла локальных переменных.
Но это уже детали, главное здесь то, что цикл, как и функция, включает
последовательность операторов и для их компиляции может быть использована
сама функция Ctrl так же, как она используется для компиляции всей функции.
Условие цикла компилируется не лучшим образом. Как минимум, генерируются
излишние команды (or AL,AL ...), но сейчас простота важнее эффективности. Также
из приведенного фрагмента неясно, как будет скомпилировано сложное условие,
содержащее логические операторы И/ИЛИ, будет ли реализована полная или краткая
оценка условия. Этот вопрос должен быть решен при написании функции Expr.
По-видимому, полное вычисление с использованием регистра для хранения результата
является наиболее простым, в некоторых языках (например в оригинальном Pascal)
так и сделано. Так сделано и в Context'е, но это не лучшее решение.
Компиляция фоpмул похожа на уже известное вычисление аpифметических выpажений.
Отличия лишь в том, что входящие в пpогpамму выpажения могут содеpжать не только
числа и знаки аpифметических опеpаций, но также идентификатоpы пеpеменных и
вызовы функций. Кpоме того, во вpемя компиляции ничего не вычисляется, а
создается машинный код. Все это может быть pеализовано в виде одной pекуpсивной
функции Expr. Эта функция должна вычислить адрес результата или значение (если
объект - константа).
void Expr(word Prty; char @Buff; OpInfo @Op1)
select
case strcmp(@Buff,"(")=0:
// вырадение в скобках
case strcmp(@Buff,"'")=0:
// символьная константа
case strcmp(@Buff,"#")=0:
// символьная константа
case isdigit(Buff)=0:
// числовая константа
default:
// Переменная, вызов функции
end
while TRUE do
word Sign;
word P2;
select
case strcmp(@Buff,"|")=0:
Sign=OR;
P2 =1;
case strcmp(@Buff,"&")=0:
Sign=AND;
P2 =1;
case strcmp(@Buff,"<")=0:
Sign=LT;
P2 =2;
...
case strcmp(@Buff,"%")=0:
Sign=MOD;
P2 =4;
default:
P2=0;
end
if P2<=P then
exit
end
Expr(P2,@Scan(@Buff),@Op2);
// Проверка совместности типов и компиляция оператора Sign
end
end
Стоит отметить, что так написанная функция Expr всегда считывает лишнее слово.
Это может быть точка с запятой, двоеточие, then, do.
Идеи сформулированы и вот как они реализованы в 'игрушечном' компиляторе.
Упрощение достигнуто в первую очередь за счет упрощения языка. Только один тип
данных - целое (но условия считаются логическими), определение новых типов
невозможно, только одномерные массивы, нет функций и локальных переменных, нет
ссылочных переменных. И никаких попыток оптимизации. Собственно компилятор
начинается с функции Read:
define @emNOMEMORY "Недостаточно памяти"
define @emSIZE "Слишком длинный идентификатоp"
define @emEOF "Конец файла"
define @emNUMBER "Ошибка в константе"
define @emNAME "Пpопущено имя"
define @emEMPTY "Пустой массив"
define @emBRACKET "Пpопущена скобка"
define @emCOMMA "Пpопущена запятая"
define @emSEMICOLON "Пpопущена точка с запятой"
define @emTHENEXP "Пpопущено then"
define @emDOEXP "Пpопущено do"
define @emDUP "Повтоpное описание"
define @emLVALUE "Пpопущена пеpеменная"
define @emTYPE "Несоответствие типов"
define @emUNDEFINED "Пеpеменная не опpеделена"
define @emUNDEFOPR "Опеpация не опpеделена"
define @emASSIGN "Пpопущено ="
define tbSIZE 8192
define dbSIZE 8192
define dtSIZE 128
define idSIZE 16
define opOR 1
define opAND 2
define opLT 3
define opLE 4
define opEQ 5
define opNE 6
define opGE 7
define opGT 8
define opADD 9
define opSUB 10
define opMUL 11
define opDIV 12
define opNOT 13
define opNEG 14
define ptZERO 0
define ptBOOL 1
define ptCOMP 2
define ptADD 3
define ptMUL 4
define ptLVALUE 5
define ttWORD 0
define ttBOOL 1
struct DATA
char Name [idSIZE];
word Ofs;
word Index;
end
DATA Data [dtSIZE];
word nData;
word Ofs;
char Text [tbSIZE];
word hText;
word nText;
word pText;
char Name [128];
word Line;
word Label;
char Dest [dbSIZE];
word hDest;
word pDest;
void @Ptr(word Seg, Ofs)
void @P1=@Ofs;
void @@P2=@P1;
return @P2;
end
word isalpha(char Ch)
if ('A'<=Ch & Ch<='Z') | ('a'<=Ch & Ch<='z') | (Ch='_') then
return 0;
end
return 1;
end
word isdigit(char Ch)
if ('0'<=Ch & Ch<='9') then
return 0;
end
return 1;
end
word strlen(char @Buff)
word P=0;
while Buff[P]!=#0 do
inc P;
end
return P;
end
word strcmp(char @St1, @St2)
word P=0;
while St1[P]=St2[P] do
if St1[P]=#0 then
return 0;
end
inc P;
end
return 1;
end
char @strcpy(char @Dst, @Src)
word P=0;
while Src[P]!=#0 do
Dst[P]=Src[P];
inc P;
end
Dst[P]=#0;
return @Dst;
end
char @strcat(char @Dst, @Src)
word P=strlen(@Dst);
word Q=0;
while Src[Q]!=#0 do
Dst[P]=Src[Q];
inc P;
inc Q;
end
Dst[P]=#0;
return @Dst;
end
word GetPSP()
asm mov AH,62H
asm int 21H
asm mov AX,BX
end
word open(char @Name)
asm push DS
asm mov AH,3DH
asm mov AL,00H
asm mov DX,SS:[BP+6]
asm mov DS,DX
asm mov DX,SS:[BP+4]
asm int 21H
asm pop DS
end
word create(char @Name)
asm push DS
asm mov AH,3CH
asm mov CX,00H
asm mov DX,SS:[BP+6]
asm mov DS,DX
asm mov DX,SS:[BP+4]
asm int 21H
asm pop DS
end
word read(word F; void @Buff; word N)
asm push DS
asm mov AH,3FH
asm mov BX,SS:[BP+10]
asm mov CX,SS:[BP+4]
asm mov DX,SS:[BP+8]
asm mov DS,DX
asm mov DX,SS:[BP+6]
asm int 21H
asm pop DS
end
word write(word F; void @Buff; word N)
asm push DS
asm mov AH,40H
asm mov BX,SS:[BP+10]
asm mov CX,SS:[BP+4]
asm mov DX,SS:[BP+8]
asm mov DS,DX
asm mov DX,SS:[BP+6]
asm int 21H
asm pop DS
end
void close(word F)
asm mov AH,3EH
asm mov BX,SS:[BP+4]
asm int 21H
end
void putc(char Ch)
asm mov AH,2
asm mov DL,SS:[BP+4]
asm int 21H
end
void puts(char @St)
word P=0;
while St[P]!=#0 do
putc(St[P]);
inc P;
end
end
word str(word N; word S; char @Buff)
if S>0 then
dec S;
end
word P=0;
if N>=10 | S>0 then
P=str(N/10,S,@Buff);
end
char @D = "0123456789";
Buff [P]=D[N%10];
return P+1;
end
char @Str(word N; word S)
char @P="00000";
P[str(N,S,@P)]=#0;
return @P;
end
void Stop(char @EM)
putc(#13);
puts(@Name);
putc('(');
puts(@Str(Line,0));
putc(')');
if (strlen(@EM)>0) then
puts(": ");
puts(@EM);
end
close (hDest);
close (hText);
asm mov AX,4C00H
asm int 21H
end
word Val(char @Buff)
char @D = "0123456789";
word P = 0;
word L = 0;
word H = 0;
while Buff[P]!=#0 do
word S=0;
while D[S]!=Buff[P] do
inc S;
if S>=10 then
Stop(@emNUMBER);
end
end
S=10*L+S;
L=S%256;
S=10*H+S/256;
H=S%256;
S=S/256;
if S>0 then
Stop(@emNUMBER);
end
inc P;
end
return 256*H+L;
end
char Read()
if pText>=nText then
nText=read(hText,@Text,tbSIZE);
if nText<1 then
Stop(@emEOF);
end
pText=0;
end
return Text[pText];
end
void Next()
inc pText;
end
char @Scan(char @Buff)
while Read()=#09 | Read()=#10 | Read()=#13 | Read()=#32 do
if Read()=#10 then
inc Line;
end
Next();
end
word P=0;
while isalpha(Read())=0 | isdigit(Read())=0 do
Buff[P]=Read();
inc P;
if P>=idSIZE then
Stop(@emSIZE);
end
Next();
end
if P=0 then
Buff[P]=Read();
inc P;
Next();
select
case Buff[0]='<':
if Read()='=' then
Next();
return @strcpy(@Buff,"<=");
end
case Buff[0]='!':
if Read()='=' then
Next();
return @strcpy(@Buff,"!=");
end
case Buff[0]='>':
if Read()='=' then
Next();
return @strcpy(@Buff,">=");
end
end
end
Buff[P]=#0;
return @Buff;
end
void Save(char Ch)
if pDest>=dbSIZE then
Stop(@emNOMEMORY);
end
Dest[pDest]=Ch;
inc pDest;
end
void Decl(char @Inst)
word I=0;
while Inst[I]!=#0 do
Save(Inst[I]);
inc I;
end
Save(#13);
Save(#10);
end
void Code(word L; char @Inst)
if L!=0 then
Save('@');
char @P=@Str(L,5);
word I=0;
while P[I]!=#0 do
Save(P[I]);
inc I;
end
Save(':');
Save(' ');
else
word I=0;
while I<8 do
Save(' ');
inc I;
end
end
Decl(@Inst);
end
word Jump(word L)
char Buff [28];
word P=pDest;
Code(0,@strcat(@strcpy(@Buff,"jmp @"),@Str(L,5)));
return P;
end
word Find(char @Name)
word P=0;
while P<nData do
if strcmp(@Data[P].Name,@Name)=0 then
exit
end
inc P;
end
return P;
end
word Comp(char @Jump)
char Buff [128];
Code(0, "cmp BX,AX");
Code(0, "mov AL,1");
Code(0, @strcat(@strcat(@strcpy(@Buff,@Jump)," @"),@Str(Label,5)));
Code(0, "xor AL,AL");
Code(Label,"nop");
inc Label;
return ttBOOL;
end
word Expr(word Prty; char @Buff)
word Type=ttWORD;
word Flag=0;
word N;
select
case strcmp(@Buff,"(")=0:
Type=Expr(ptZERO,@Scan(@Buff));
if strcmp(@Buff,")")!=0 then
Stop(@emBRACKET);
end
case isdigit(Buff)=0:
word C=Val(@Buff);
Code(0,@strcat(@strcpy(@Buff,"mov AX,"),@Str(C,0)));
default:
N=Find(@Buff);
if N>=nData then
Stop(@emUNDEFINED);
end
if Data[N].Index>0 then
if strcmp(@Scan(@Buff),"[")!=0 then
Stop(@emBRACKET);
end
if Expr(ptZERO,@Scan(@Buff))!=ttWORD then
Stop(@emTYPE);
end
if strcmp(@Buff,"]")!=0 then
Stop(@emBRACKET);
end
if Prty<ptLVALUE then
Code(0,"mov BX,AX");
Code(0,"shl BX,1");
Code(0,@strcat(@strcat(@strcpy(@Buff,"mov AX,DS:[BX+"),@Str(Data[N].Ofs,0)),"]"));
end
else
if Prty<ptLVALUE then
Code(0,@strcat(@strcat(@strcpy(@Buff,"mov AX,DS:["),@Str(Data[N].Ofs,0)),"]"));
end
end
Flag=1;
end
Scan(@Buff);
if Prty>=ptLVALUE then
if Flag=0 then
Stop(@emLVALUE);
end
return N;
end
while TRUE do
word Op;
word P;
select
case strcmp(@Buff,"|")=0:
Op=opOR;
P =ptBOOL;
case strcmp(@Buff,"&")=0:
Op=opAND;
P =ptBOOL;
case strcmp(@Buff,"<")=0:
Op=opLT;
P =ptCOMP;
case strcmp(@Buff,"<=")=0:
Op=opLE;
P =ptCOMP;
case strcmp(@Buff,"=")=0:
Op=opEQ;
P =ptCOMP;
case strcmp(@Buff,"!=")=0:
Op=opNE;
P =ptCOMP;
case strcmp(@Buff,">=")=0:
Op=opGE;
P =ptCOMP;
case strcmp(@Buff,">")=0:
Op=opGT;
P =ptCOMP;
case strcmp(@Buff,"+")=0:
Op=opADD;
P =ptADD;
case strcmp(@Buff,"-")=0:
Op=opSUB;
P =ptADD;
case strcmp(@Buff,"*")=0:
Op=opMUL;
P =ptMUL;
case strcmp(@Buff,"/")=0:
Op=opDIV;
P =ptMUL;
default:
P =ptZERO;
end
if P<=Prty then
exit
end
Code(0,"push AX");
if Expr(P,@Scan(@Buff))!=Type then
Stop(@emTYPE);
end
Code(0,"pop BX");
select
case Type=ttBOOL:
select
case Op=opOR:
Code(0,"or AL,BL");
case Op=opAND:
Code(0,"and AL,BL");
default:
Stop(@emUNDEFOPR);
end
case Type=ttWORD:
select
case Op=opLT:
Type=Comp("jb ");
case Op=opLE:
Type=Comp("jbe");
case Op=opEQ:
Type=Comp("je ");
case Op=opNE:
Type=Comp("jne");
case Op=opGE:
Type=Comp("jae");
case Op=opGT:
Type=Comp("ja ");
case Op=opADD:
Code(0,"add AX,BX");
case Op=opSUB:
Code(0,"db 93H; xchg AX,BX");
Code(0,"sub AX,BX");
case Op=opMUL:
Code(0,"mul BX");
case Op=opDIV:
Code(0,"db 93H; xchg AX,BX");
Code(0,"xor DX,DX");
Code(0,"div BX");
default:
Stop(@emUNDEFOPR);
end
end
end
return Type;
end
void Ctrl(char @Buff)
select
case strcmp(@Buff,"if")=0:
if Expr(ptZERO,@Scan(@Buff))!=ttBOOL then
Stop(@emTYPE);
end
if strcmp(@Buff,"then")!=0 then
Stop(@emTHENEXP);
end
Code(0, "or AL,AL");
Code(0, @strcat(@strcpy(@Buff,"jne @"),@Str(Label,5)));
word P=Jump(0);
Code(Label,"nop");
inc Label;
while strcmp(@Scan(@Buff),"end")!=0 do
Ctrl(@Buff);
end
Code(Label,"nop");
word pDest1=pDest;
pDest= P;
Jump (Label);
pDest=pDest1;
inc Label;
case strcmp(@Buff,"while")=0:
word While=Label;
Code(Label,"nop");
inc Label;
if Expr(ptZERO,@Scan(@Buff))!=ttBOOL then
Stop(@emTYPE);
end
if strcmp(@Buff,"do")!=0 then
Stop(@emDOEXP);
end
Code(0, "or AL,AL");
Code(0, @strcat(@strcpy(@Buff,"jne @"),@Str(Label,5)));
word P=Jump(0);
Code(Label,"nop");
inc Label;
while strcmp(@Scan(@Buff),"end")!=0 do
Ctrl(@Buff);
end
Code(0, @strcat(@strcpy(@Buff,"jmp @"),@Str(While,5)));
Code(Label,"nop");
word pDest1=pDest;
pDest= P;
Jump (Label);
pDest=pDest1;
inc Label;
case strcmp(@Buff,"write")=0:
while TRUE do
if Expr(ptZERO,@Scan(@Buff))!=ttWORD then
Stop(@emTYPE);
end
Code(0,"mov CX, 8");
Code(0,"call @WRITE");
if strcmp(@Buff,",")!=0 then
exit
end
end
if strcmp(@Buff,";")!=0 then
Stop(@emSEMICOLON);
end
Code(0,"mov AH, 2");
Code(0,"mov DL,13");
Code(0,"int 21H");
Code(0,"mov AH, 2");
Code(0,"mov DL,10");
Code(0,"int 21H");
case strcmp(@Buff,"blank")=0:
Code(0,"mov AH, 2");
Code(0,"mov DL,13");
Code(0,"int 21H");
Code(0,"mov AH, 2");
Code(0,"mov DL,10");
Code(0,"int 21H");
default:
word N=Expr(ptLVALUE,@Buff);
if N>=nData then
Stop(@emUNDEFINED);
end
if strcmp(@Buff,"=")!=0 then
Stop(@emASSIGN);
end
if Data[N].Index>0 then
Code(0,"push AX");
end
if Expr(ptZERO,@Scan(@Buff))!=ttWORD then
Stop(@emTYPE);
end
if Data[N].Index>0 then
Code(0,"pop BX");
Code(0,"shl BX,1");
Code(0,@strcat(@strcat(@strcpy(@Buff,"mov DS:[BX+"),@Str(Data[N].Ofs,0)),"],AX"));
else
Code(0,@strcat(@strcat(@strcpy(@Buff,"mov DS:["),@Str(Data[N].Ofs,0)),"],AX"));
end
end
end
begin
byte @Size=@Ptr(GetPSP(),128);
char @Parm=@Ptr(GetPSP(),129);
char name [128];
word I=0;
while I<Size & Parm[I] =' ' do
inc I;
end
word Flag=0;
word K =0;
word E;
while I<Size & Parm[I]!=' ' do
name[K]=Parm[I];
if name[K]='.' then
E =K;
Flag=1;
end
if name[K]='\' then
Flag=0;
end
inc K;
inc I;
end
name[K]=#00;
if K=0 then
return
end
if Flag=0 then
strcat(@name,".ctx");
E=K;
end
I=0;
K=0;
while name[I]!=#0 do
if name[I]=#92 then
K=I+1;
end
inc I;
end
strcpy(@Name,@name[K]);
hText=open(@name);
strcpy(@name[E],".asm");
hDest=create(@name);
pText=0;
nText=0;
pDest=0;
nData=0;
Ofs =0;
Label=1;
Line =1;
Code(0,"mov AX,DS");
Code(0,"add AX,4096");
Code(0,"mov DS,AX");
char Buff [128];
while TRUE do
Scan(@Buff);
select
case strcmp(@Buff,"word")=0:
while TRUE do
if isalpha(Scan(@Buff))!=0 then
Stop(@emNAME);
end
if Find(@Buff)<nData then
Stop(@emDUP);
end
if nData>=dtSIZE then
Stop(@emNOMEMORY);
end
Data[nData].Ofs =2*Ofs; strcpy(@Data[nData].Name,@Buff);
Data[nData].Index=0;
word N=1;
if strcmp(@Scan(@Buff),"[")=0 then
N=Val(@Scan(@Buff));
if N<1 then
Stop(@emEMPTY);
end
Data[nData].Index=N;
if strcmp(@Scan(@Buff),"]")!=0 then
Stop(@emBRACKET);
end
Scan(@Buff);
end
Ofs=Ofs+N;
inc nData;
if strcmp(@Buff,";")=0 then
exit
end
if strcmp(@Buff,",")!=0 then
Stop(@emCOMMA);
end
end
case strcmp(@Buff,"begin")=0:
while strcmp(@Scan(@Buff),"end")!=0 do
Ctrl(@Buff);
end
exit
default:
Stop(@emUNDEFINED);
end
end
Code(0,"mov AX,4C00H");
Code(0,"int 21H");
Decl("@WRITE: dec CX");
Decl(" xor DX,DX");
Decl(" mov BX,10");
Decl(" div BX");
Decl(" push DX");
Decl(" or AX,AX");
Decl(" jz @SPACE");
Decl(" call @WRITE");
Decl(" jmp @DIGIT");
Decl("@SPACE: mov AH, 2");
Decl(" mov DL,32");
Decl(" int 21H");
Decl(" dec CX");
Decl(" jnz @SPACE");
Decl("@DIGIT: mov AH, 2");
Decl(" pop DX");
Decl(" add DL,48");
Decl(" int 21H");
Decl(" retn");
write(hDest,@Dest,pDest);
Stop ("");
end
Из средств ввода/вывода реализованы лишь оператор write, выводящий на печать
числа и оператор blank, выполняющий перевод строки. Для демонстрации можно
скомпилировать и выполнить следующую программу сортировки массива:
word Buff[16];
word Temp;
word I;
word J;
word N;
begin
N=10;
I=0;
while I<N do
Buff[I]=N-I;
I=I+1;
end
I=0;
while I<N do
write I, Buff[I];
I=I+1;
end
I=N;
while I>0 do
I=I-1;
J=0;
while J<N do
if Buff[J]>Buff[J+1] then
Temp =Buff[J+1];
Buff[J+1]=Buff[J];
Buff[J] =Temp;
end
J=J+1;
end
end
blank
I=0;
while I<N do
write I, Buff[I];
I=I+1;
end
end
Полная версия компилятора сложнее, но и в ней сделаны упрощения. Они связаны
с обязательным размещением операндов в регистрах, причем это размещение
фиксировано:
все аpифметические и логические опеpации выполняются только в pегистpах
пеpвый опеpанд pазмещается в pегистpе AL (байт), AX (слово) или DX:AX (двойное слово)
втоpой опеpанд pазмещается в pегистpе BL (байт), BX (слово) или CX:BX (двойное слово)
pезультат опеpации pазмещается в pегистpе AL (байт), AX (слово) или DX:AX (двойное слово)
pегистp DI используется для обpащения к элементу массива
pегистpы ES:DI используются для pазименования указателей
если нужный pегистp занят, значение из него вpеменно помещается в стек
пpи вызовах функций паpаметpы пеpедаются чеpез стек, паpаметpы удаляются
из стека пеpед завеpшением функции, pезультат функции возвpащается в pегистpе
AL (байт), AX (слово) или DX:AX (двойное слово), в целях упpощения pезультат
функции может иметь длину только 1, 2 или 4 байта.
глобальные пеpеменные находятся в сегменте, адpесуемом pегистpом DS
Основные блоки компилятора следующие:
void Stop(char @EM) // Завеpшение компиляции
...
end
void Code(word L; char @S) // Фоpмиpование стpоки кода
...
end
char Read() // Чтение символа
...
end
void Next() // Пеpеход к следующему символу
...
end
char @Scan(char @Buff) // Чтение слова
...
end
void Init() // Инициализация (для Expr)
...
end
void Push(word R) // Запись регистра в стек
...
end
void Pop (word R) // Извлечение из стека
...
end
void LDAX(OpInfo @Op1) // Загpузка первого опеpанда в (DX:)AX
...
end
void LDBX(OpInfo @Op1) // Загpузка второго опеpанда в (CX:)BX
...
end
void LPTR(OpInfo @Op1) // Загpузка указателя в ES:DI
...
end
void STAX(OpInfo @Op1) // Запись pезультата в память
...
end
word Comp(word Size; char @Jump) // Сpавнение
...
end
void Test(word pType1; word nPtr1; OpInfo @Op2) // Пpовеpка
... // совместности типов
end
void Expr(word P; char @Buff; OpInfo @Op1) // Компиляция
... // выражения
end
void Ctrl(char @Buff) // Компиляция блока
...
end
begin
...
while (strcmp(@Scan(@Buff),"begin")!=0) do
if (strcmp(@Buff,"define")=0) then // Pазбоp константы
...
loop
end
if (strcmp(@Buff,"struct")=0) then // Pазбоp стpуктуpы
...
loop
end
P=FindType(@Buff);
if (P<nType) then // Pазбоp пеpеменной
... // или функции
loop
end
Stop(@emUNDEFINED);
end
...
while (strcmp(@Scan(@Buff),"end")!=0) do // Компиляция
Ctrl(@Buff); // главного блока
end
...
end
Нужно сказать несколько слов о модификации компилятора. Сделанные при этом
ошибки могут не проявиться после однократной компиляции. Т.е. если с помощью
компилятора A компилируется текст компилятора A' (исправленного и дополненного A)
и при этом не обнаруживается синтаксических или семантических ошибок, компилятор A'
вероятно сможет скомпилировать себя, но полученный компилятор A'' может быть
неработоспособен.
И последнее замечание. Компилятор создает листинг, немного отличный от
тpебуемого для ассемблеpа TASM. Если вы хотите использовать TASM/TLINK,
в начало нужно добавить стpоки