Разработка компилятора подмножества языка Паскаль на язык Ассемблера

Работу приняла

Работу выполнил

Прасолова А.Е

Работу приняла:

Доцент кафедры

Ардабьев В.А.

Курск 2011 г.

Цель работы

Изучение составных частей, основных принципов построения и функционирования компиляторов.

Создание компилятора с заданного подмножества языка Паскаль с незначительными модификациями и упрощениями (полное описание входного и выходного языков дано далее в задании для каждого варианта).

Задание

Входной язык компилятора должен удовлетворять следующим требованиям:

· входная программа начинается ключевым словом prog и заканчивается ключевым словом end;

· входная программа может быть разбита на строки произвольным образом, все пробелы и переводы строки должны игнорироваться компилятором;

· текст входной программы может содержать комментарии любой длины, которые должны игнорироваться компилятором (вид комментария задан в варианте задания);

· входная программа должна представлять собой единый модуль, содержащий линейную последовательность операторов, вызовы процедур и функций не предусматриваются;

· должны быть предусмотрены следующие варианты операторов входной программы:

· оператор присваивания вида <переменная>:=<выражение>;

· условный оператор вида if <выражение> then <оператор>, либо if <выражение> then <оператор> else <оператор>;

· составной оператор вида begin … end;

· оператор цикла, предусмотренный вариантом задания;

· выражения в операторах могут содержать следующие операции (минимум):

· арифметические операции сложения (+) и вычитания (-);

· операции сравнения меньше (<), больше (>), равно (=);

· логические операции “и” (and), “или” (or), “нет” (not);

· дополнительные арифметические операции, предусмотренные вариантом задания;

· операндами в выражениях могут выступать идентификаторы (переменные) и константы (тип допустимых констант указан в варианте задания);

· все идентификаторы, встречающиеся в исходной программе, должны восприниматься как переменные, имеющие тип, заданный в варианте задания (предварительное описание идентификаторов в исходной программе не требуется).

Приоритет операций исполнитель работы должен выбрать самостоятельно (приоритет операций учитывается в грамматике входного языка). Для изменения приоритета операций должны использоваться круглые скобки. Полное описание входного языка должно быть задано в грамматике входного языка, которая строится исполнителем на первом этапе работы. Грамматика входного языка должна предусматривать любые входные цепочки, удовлетворяющие изложенным выше требованиям.

Допускаются любые модификации входного языка по выбору исполнителя, если они не выходят за рамки указанных выше требований. Допускается расширять набор разрешенных операций и операторов входного языка при условии удовлетворения заданным минимальным требованиям.

Индивидуальный вариант задания

Типы дополнительных операторов цикла:

1 - цикл с предусловием вида while <выражение> do <оператор>;

Типы комментариев:

1 - комментарий в фигурных скобках: {…}

Грамматика входного языка в форме Бэкуса-Наура

<начало>>prog

<буква>>a|b|c|d|e|f|g|h|i|j|k|l|m|n|o|p|q|r|s|t|u|v|w|x|y|z|A|B|C|D|E|F|G|H|I|J|K|L|M|N|O|P|Q|R|S|T|U|V|W|X|Y|Z

<все_цифры>> 0|1|2|3|4|5|6|7|8|9

<идентификатор>><буква>{<буква>}|{<буква><все_цифры>}

<цифра>>0|1

<число>><цифра>{<цифра>}

<знак_слож_выч>>+|-

<знак_умн_дел>>*|/

<операц_присвоен>> :=

<завершение_оператора>>;

<множитель>> <число>|<идентификатор>|(<формула>)

<слагаемое>> <множитель>{<знак_умн_дел><множитель>}

<формула>> <слагаемое> {<знак_слож_выч><слагаемое>}

<оператор>><идентификатор><операц_присвоен><формула><завершение_оператора>

<логич_операц>>or|nor|<|>|<>

<логич_оператор>>(<идентификатор>|<число>)<логич_операц>(<идентификатор>|<число>)

<операт_условн>>if(<логич_оператор>)then{<оператор>}{else<оператор>}

<операт_цикла>>while(<логич_оператор>)do<оператор>

<открыв_фигур_скобка>>{

<закрыв_фигур_скобка>>}

<комментарий>><открыв_фигур_скобка><любые_символы><закрыв_фигур_скобка>

<конец>>end.

Описание выбранного способа организации таблицы идентификаторов

Для организации таблицы идентификаторов выберем комбинированный способ, поскольку в нем отсутствуют ограничения на количество входных идентификаторов, и он не требует разработки сложной и эффективной хэш-функции (разработка комбинированной таблицы в данном случае проще, чем выбор хорошей хэш-функции).

В качестве такого способа возьмем комбинацию хэш-адресации и бинарного дерева.

В качестве хэш-функции будем использовать сумму кодов первой и средней буквы. При этом для идентификаторов длины в 1 и 2 символа необходимо сделать исключение и в качестве хэш-адреса для них будет возвращаться код первой буквы.

Метод разрешения коллизий «бинарное дерево» заключается в построении бинарного дерева, корнем которого является ячейка хеш-таблицы. При возникновении коллизии ключ добавляется в левое или правое поддерево в зависимости от его значения. Процедура выполняется рекурсивно.

Графически это можно изобразить следующим образом

компилятор подмножество язык паскаль

Описание лексического анализатора

Задача лексического анализатора для описанного выше языка заключается в том, чтобы распознавать и выделять в исходном тексте программы все лексемы этого языка. Лексемами данного языка являются:

ключевые слова : prog, end., begin, end, if, then, else, while, do, and, or, not;

идентификаторы: любые последовательности латинских символов и цифр;

константы: двоичное представление числа;

знаки операций: =, <, >, -, +, *, /;

оператор присваивания: :=;

разделитель: ;, (, );

комментарии, заключенные в { }.

Лексический анализатор имеет дело с такими объектами, как различного рода константы и идентификаторы (к последним относятся и ключевые слова). Язык констант и идентификаторов в большинстве случаев является регулярным - то есть, может быть описан с помощью регулярных грамматик. Распознавателями для регулярных языков являются конечные автоматы. Существуют правила, с помощью которых для любой регулярной грамматики может быть построен недетерминированный конечный автомат, распознающий цепочки языка, заданного этой грамматикой.

Недетерминированный конечный автомат задается пятеркой:

M=(Q,,,q0,F)

где: Q - конечное множество состояний автомата;

- конечное множество допустимых входных символов;

- заданное отображение множества Q* во множество подмножеств P(Q) : Q*P(Q) (иногда называют функцией переходов автомата);

q0Q - начальное состояние автомата;

FQ - множество заключительных состояний автомата.

Работа автомата выполняется по тактам. На каждом очередном такте i автомат, находясь в некотором состоянии qiQ, считывает очередной символ w из входной цепочки символов и изменяет свое состояние на qi+1=(qi,w), после чего указатель в цепочке входных символов передвигается на следующий символ и начинается такт i+1. Так продолжается до тех пор, пока цепочка входных символов не закончится. Конец цепочки символов часто помечают особым символом . Считается также, что перед тактом 1 автомат находится в начальном состоянии q0.

Графически автомат отображается нагруженным однонаправленным графом, в котором вершины представляют состояния, дуги отображают переходы из одного состояния в другое, а символы нагрузки (пометки) дуг соответствуют функции перехода. Если функция перехода предусматривает переход из состояния q в q' по нескольким символам, то между ними строится одна дуга, которая помечается всеми символами, по которым происходит переход из q в q'.

Схема взаимодействия лексического анализатора с синтаксическим выглядит следующим образом:

Граф переходов конечного автомата лексического анализатора

Исходная КС-грамматика

G({prog, end., if, else, then, begin, end, while, do, or, and, not, <, >, =, <>, (, ), -, +, *, /, a, c, :, :=},{S, L, O, B, C, D, E, T, F}, P, S)

P :

S> prog L end.

L>O | L;O | L;

O>if (B) then O else O | if (B) then O | begin L end | while (B) do O | a:=E

B>B or C | C

C>C and D | D

D>E<E | E>E | E=E | E<>E | (B) | not (B)

E>E-F | E+F | E*F | E/F | F

F>(E) | a | c

P - правила;

S - вся программа;

L - последовательность операторов;

O - операторы;

B,C - логические выражения и элементы;

D - операция сравнения или логическое выражение в скобках;

E, F - арифметические выражения и элементы.

a и c - переменная и константа соответственно.

Описание синтаксического анализатора

Для построения синтаксического анализатора будем использовать анализатор на основе грамматик операторного предшествования. Этот анализатор является линейным распознавателем (время анализа линейно зависит от длины входной цепочки), для него существует простой и эффективный алгоритм построения распознавателя на основе матрицы предшествования. К тому же алгоритм «сдвиг-свертка» для данного типа анализатора был разработан при выполнении лабораторной работы № 3, а поскольку он не зависит от входного языка, он может быть без модификаций использован в данной работе.

Для построения анализатора на основе грамматики операторного предшествования необходимо построить матрицу операторного предшествования. Построим множества крайних левых и крайних правых символов грамматики G.

Таблица 1. Множество крайних левых и крайних правых символов на двух первых шагах

Таблица 2. Множество крайних левых и крайних правых символов на 3-м и 4-м шаге

После этого необходимо построить множества крайних левых и крайних правых терминальных символов. На первом шаге возьмем все крайние левые и крайние правые терминальные символы из правил грамматики С. Дополним эти множества на основе ранее построенных множеств крайних левых и крайних правых символов, представленных в таблицы 2. Получим множества крайних левых и крайних правых терминальных символов, которые представлены в таблице 3.

Таблица 3. Множество крайних левых и крайних правых терминальных символов

После построения множеств, представленных в таблице 3, можно заполнять матрицу операторного предшествования.

После того как заполнена матрица операторного предшествования, на основе исходной грамматики G можно построить остовную грамматику.

G({prog, end., if, else, then, begin, end, while, do, or, and, not, <, >, =, <>, (, ), -, +, *, /, a, c, :, :=}, {E}, P', E)

E > prog E end.

E > E | E ; E | E ;

E > if E then E else E | if E then E | begin E end| while (E) do E| a:=E | E

E > E or E | E

E > E and E | E

E > E < E | E > E | E = E | E<>E | (E) | not (E)

E > E - E | E + E | E * E| E / E | E

E>(E) | a | c

Приоритет арифметических и логических операций определяют круглые скобки, поэтому остовная грамматика дополняется нетерминальным символом B, который будет обозначать логические выражения. Преобразованная остовная грамматика будет иметь следующий вид:

G({prog, end., if, else, then, begin, end, while, do, or, and, not, <, >, =, <>, (, ), -, +, *, /, a, c, :, :=}, {E}, P*, E)

E > prog E end.

E > E | E ; E | E ;

E > if (B) then E else E | if (B) then E | begin E end | while (B) do E| a:=E | E

B > B or B | B

B > B and B | B

B > E < E | E > E | E = E | (B) | not (B)

E > E - E | E + E | E * E| E / E | E

E>(E) | a | c

Выбор форм внутреннего представления программы

В качестве формы внутреннего представления программы будут использоваться триады. В данном случае в пользу выбора триад говорят два определяющих фактора:

- для работы с триадами уже имеются необходимые структуры данных (соответствующие программные модули созданы при выполнении лабораторной работы № 4);

- алгоритмы оптимизации, которые предполагается использовать, основаны на внутреннем представлении программы в форме триад.

В данной работе создается простейший компилятор, поэтому другие формы внутреннего представления программы не понадобятся. Результирующая программа будет порождаться на языке ассемблера на самой последней стадии компиляции, ее внутреннее хранение и обработка не предусмотрены.

Описание используемого метода порождения результирующего кода

Для порождения результирующего кода будет использоваться рекурсивный алгоритм порождения списка триад на основе дерева синтаксического разбора.

В данном входном языке мы имеем следующие типы операций:

- логические операции (or, and и not);

- операции сравнения (<, >, = и <>);

- арифметические операции (сложение, вычитание, умножение, деление);

- оператор присваивания;

- полный условный оператор (if... then ... else ...) и неполный условный

оператор (if... then...);

- оператор цикла с предусловием (while(...)do...);

- операции, не несущие смысловой нагрузки, а служащие только для создания синтаксических конструкций исходной программы (заголовок программы, операторные скобки begin...end, круглые скобки и точка с запятой).

Рассмотрим несколько примеров порождения результирующего кода:

Генерация кода для цикла с предусловием выполняется в следующем порядке:

1). Порождается блок кода № 1, вычисляющий логическое выражение, находящееся между лексемами while ( (первая и вторая нижележащие вершины) и ) (четвертая нижележащая вершина) -- для этого должна быть рекурсивно вызвана функция порождения кода для третьей нижележащей вершины.

2). Порождается команда условного перехода, которая передает управление в зависимости от результата вычисления логического выражения:

- в начало блока кода № 2, если логическое выражение имеет ненулевое значение;

- в конец оператора, если логическое выражение имеет нулевое значение.

3). Порождается блок кода № 2, соответствующий операциям после лексемы do (пятая нижележащая вершина) -- для этого должна быть рекурсивно вызвана функция порождения кода для шестой нижележащей вершины.

4). Порождается команда безусловного перехода в начало блока кода № 1

Рис.2. Схема СУ-перевода для оператора цикла с предусловием

Таким образом, для реализации оператора цикла достаточно иметь те же типы триад, которые необходимы для реализации условных операторов:

- IF(<операнд1>.<операнд2>) -- триада условного перехода;

- JMP(l, <операнд2>) -- триада безусловного перехода.

Для условных операторов генерация кода может выполняться в следующем порядке:

1). Порождается блок кода № 1, вычисляющий логическое выражение, находящееся между лексемами if (первая нижележащая вершина) и then (третья нижележащая вершина). Для этого должна быть рекурсивно вызвана функция порождения кода для второй нижележащей вершины, в качестве первого аргумента ей передается адрес блока кода № 2, а в качестве второго аргумента -- адрес блока кода № 3 (для полного условного оператора) или адрес конца оператора (для неполного условного оператора).

2). Порождается блок кода № 2, соответствующий операциям после лексемы then (третья нижележащая вершина) -- для этого должна быть рекурсивно вызвана функция порождения кода для четвертой нижележащей вершины (оба аргумента нулевые).

3). Для полного условного оператора порождается команда безусловного перехода в конец оператора.

4). Для полного условного оператора порождается блок сода № 3, соответствующий операциям после лексемы else (пятая нижележащая вершина) -- для этого должна быть рекурсивно вызвана функция порождения кода для шестой нижележащей вершины (оба аргумента нулевые).

Список использованной литературы

1. Системное программное обеспечение: Учебник для вузов/ А.Ю. Молчанов- СПб.: Питер, 2003.- 396 с.

2. Ахо Альфред В., Сети Рави, Ульман Джеффри Д. Компиляторы: принципы, технологии и инструменты.: Пер. с англ. - М.: Издательский дом “Вильямс”, 2003.

3. Коровинский В.В., Жаков В.И., Фильчаков В.В. Синтаксический анализ и генерация кода - СПб.: ГААП, 1993.

4. Бржезовский А.В., Корсакова Н.В., Фильчаков В.В. Лексический и синтаксический анализ. Формальные языки и грамматики - Л.: ЛИАП, 1990.

5. Льюис Ф. и др. Теоретические основы построения компиляторов - М.: Мир, 1979.

6. Ахо А., Ульман Дж. Теория синтаксического анализа, перевода и компиляции - М.: Мир, 1978.

7. Грис Д. Конструирование компиляторов для цифровых вычислительных машин - М.: Мир, 1975.

Приложение

unit main;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls,

Forms, Dialogs, StdCtrls, ComCtrls, Grids, ExtCtrls,

LexElem, SyntSymb, Triads, StrUtils, XPMan;

type

TErrType = (ERR_FILE, ERR_LEX, ERR_SYNT,

ERR_TRIAD, ERR_NO);

TCursovForm = class(TForm)

PageControl1: TPageControl;

SheetFile: TTabSheet;

SheetLexems: TTabSheet;

BtnExit: TButton;

GroupText: TGroupBox;

ListIdents: TMemo;

EditFile: TEdit;

BtnFile: TButton;

BtnLoad: TButton;

FileOpenDlg: TOpenDialog;

GridLex: TStringGrid;

SheetSynt: TTabSheet;

TreeSynt: TTreeView;

SheetTriad: TTabSheet;

GroupTriadAll: TGroupBox;

Splitter1: TSplitter;

GroupTriadSame: TGroupBox;

Splitter2: TSplitter;

GroupTriadConst: TGroupBox;

ListTriadAll: TMemo;

ListTriadConst: TMemo;

ListTriadSame: TMemo;

SheetAsm: TTabSheet;

ListAsm: TMemo;

Memo1: TMemo;

XPManifest1: TXPManifest;

procedure BtnLoadClick(Sender: TObject);

procedure BtnFileClick(Sender: TObject);

procedure EditFileChange(Sender: TObject);

procedure BtnExitClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormClose(Sender: TObject;

var Action: TCloseAction);

private

listLex: TLexList;

symbStack: TSymbStack;

listTriad: TTriadList;

sInpFile,sOutFile,sErrFile: string;

procedure StartInfo(const sErrF: string);

procedure ProcessParams(

var flOptC,flOptSame,flOptAsm: Boolean);

procedure InitLexGrid;

procedure MakeTree(nodeTree: TTreeNode;

symbSynt: TSymbol);

procedure ErrInfo(const sErrF,sErr: string;

iPos,iLen: integer);

function CompRun(const sInF,sOutF,sErrF: string;

var symbRes: TSymbol;

flTrd,flDelC,flDelSame,flOptC,

flOptSame,flOptAsm: Boolean): TErrType;

public

{ Public declarations }

end;

var

CursovForm: TCursovForm;

implementation

{$R *.DFM}

uses FncTree, LexType, LexAuto, TrdType, TrdMake, TrdAsm,

TrdOpt;

procedure TCursovForm.InitLexGrid;

begin

with GridLex do

begin

RowCount := 2;

Cells[0,0] := '№ п/п';

Cells[1,0] := 'Лексема';

Cells[2,0] := 'Значение';

Cells[0,1] := '';

Cells[1,1] := '';

Cells[2,1] := '';

end;

end;

procedure TCursovForm.StartInfo(

const sErrF: string);

var

i,iCnt: integer;

sTmp: string;

begin

sErrFile := sErrF;

ErrInfo(sErrFile,

Format('--- %s ---',[DateTimeToStr(Now)]),0,0);

iCnt := ParamCount;

sTmp := ParamStr(0);

for i:=1 to iCnt do

sTmp := sTmp +' '+ ParamStr(i);

ErrInfo(sErrFile,sTmp,0,0);

end;

procedure TCursovForm.ProcessParams(

var flOptC,flOptSame,flOptAsm: Boolean{флаги});

var

i,iCnt,iLen: integer;

sTmp: string;

listErr: TStringList;

begin

flOptC := True;

flOptSame := True;

flOptAsm := True;

listErr := TStringList.Create;

try

iCnt := ParamCount;

for i:=2 to iCnt do

begin

sTmp := ParamStr(i);

iLen := Length(sTmp);

if (iLen < 3) or (sTmp[1] <> '-') then

listErr.Add(Format('Неверный параметр %d: "%s"!',

[i,sTmp]))

else

case sTmp[2] of

'a','A': flOptAsm := (sTmp[3] = '1');

'c','C': flOptC := (sTmp[3] = '1');

's','S': flOptSame := (sTmp[3] = '1');

'o','O': sOutFile := System.Copy(sTmp,3,iLen-2);

'e','E': StartInfo(System.Copy(sTmp,3,iLen-2));

else

listErr.Add(Format('Неверный параметр %d: "%s"!',

[i,sTmp]));

end{case};

end{for};

if sOutFile = '' then

sOutFile := ChangeFileExt(sInpFile,'.asm');

if sErrFile = '' then

StartInfo(ChangeFileExt(sInpFile,'.err'));

iCnt := listErr.Count-1;

for i:=0 to iCnt do ErrInfo(sErrFile,listErr[i],0,0)

finally listErr.Free;

end{try};

end;

procedure TCursovForm.FormCreate(Sender: TObject);

var

flOptC,flOptSame,flOptAsm: Boolean;

symbRes: TSymbol;

iErr: TErrType;

begin

symbRes := nil;

sOutFile := '';

sErrFile := '';

InitTreeVar;

listLex := TLexList.Create;

symbStack := TSymbStack.Create;

listTriad := TTriadList.Create;

if ParamCount > 0 then

begin

sInpFile := ParamStr(1);

ProcessParams(flOptC,flOptSame,flOptAsm);

iErr := CompRun(

sInpFile,sOutFile,sErrFile{входные файлы},

symbRes{ссылка на дерево разбора},

False{запоминать списки триад не надо},

flOptC{флаг удаления триад "C"},

flOptSame{флаг удаления триад "SAME"},

flOptC{флаг оптимизации по методу

свертки объектного кода },

flOptSame{флаг оптимизации исключ.

лишних операций},

flOptAsm{флаг оптимизации команд

ассемблера});

if iErr <> ERR_FILE then Self.Close;

end;

end;

procedure TCursovForm.FormClose(Sender: TObject;

var Action: TCloseAction);

begin

listTriad.Free;

symbStack.Free;

listLex.Free;

ClearTreeVar;

Application.Terminate;

end;

procedure TCursovForm.EditFileChange(Sender: TObject);

begin

BtnLoad.Enabled := (EditFile.Text <> '');

end;

procedure TCursovForm.BtnFileClick(Sender: TObject);

begin

if FileOpenDlg.Execute then

begin

EditFile.Text := FileOpenDlg.FileName;

BtnLoad.Enabled := (EditFile.Text <> '');

end;

end;

procedure TCursovForm.ErrInfo(const sErrF,sErr: string;

iPos,iLen: integer);

var

fileErr: TextFile;

begin

if sErrF <> '' then

try

AssignFile(fileErr,sErrF);

if FileExists(sErrF) then Append(fileErr)

else Rewrite(fileErr);

writeln(fileErr,sErr);

CloseFile(fileErr);

except

MessageDlg(Format('Ошибка записи в файл "%s"!'#13#10

+ 'Ошибка компиляции: %s!',

[sErrF,sErr]),

mtError,[mbOk],0);

end

else

begin

ListIdents.SelStart := iPos;

ListIdents.SelLength := iLen;

{ Выводим сообщение на экран }

MessageDlg(sErr,mtWarning,[mbOk],0);

ListIdents.SetFocus;

end;

end;

function TCursovForm.CompRun(

const sInF,{имя входного файла}

sOutF,{имя результирующего файла}

sErrF{имя файла ошибок}:string;

var symbRes: TSymbol;{корень дерева разбора}

flTrd,{флаг записи триад в списки}

flDelC,{флаг удаления триад типа ""}

flDelSame,{флаг удаления триад типа ""}

flOptC,{флаг оптимизации методом свертки}

flOptSame,{флаг оптимизации методом

исключения лишних операций}

flOptAsm{флаг оптимизации ассемблерного кода}

: Boolean): TErrType;

var

i,iCnt,iErr: integer;

lexTmp: TLexem;

sVars,sAdd: string;

asmList: TStringList;

begin

listLex.Clear;

symbStack.Clear;

listTriad.Clear;

try

Memo1.Lines.LoadFromFile(sInF);

ListIdents.Lines := Memo1.Lines;

for i := 0 to ListIdents.Lines.Count - 1 do

begin

ListIdents.Lines[i]:=AnsiReplaceStr(ListIdents.Lines[i], '*', '+');

ListIdents.Lines[i]:=AnsiReplaceStr(ListIdents.Lines[i], '/', '-');

ListIdents.Lines[i]:=AnsiReplaceStr(ListIdents.Lines[i], 'then', '');

end;

except

Result := ERR_FILE;

MessageDlg('Ошибка чтения файла!',mtError,[mbOk],0);

Exit;

end;

iErr := MakeLexList(ListIdents.Lines,listLex);

if iErr <> 0 then

begin

ErrInfo(sErrF,

Format('Неверная лексема "%s" в строке %d!',

[listLex[0].LexInfoStr,iErr]),

listLex[0].PosAll,listLex[0].PosNum);

Result := ERR_LEX;

end

else

begin

with ListIdents do

listLex.Add(TLexem.CreateInfo('Конец строки',

Length(Text),Lines.Count-1,0));

symbRes := BuildSyntList(listLex,symbStack);

if symbRes.SymbType = SYMB_LEX then

begin

ErrInfo(sErrF,

Format('Синтаксическая ошибка в строке %d поз. %d!',

[symbRes.Lexem.StrNum+1,symbRes.Lexem.PosNum]),

symbRes.Lexem.PosAll,0);

symbRes.Free;

symbRes := nil;

Result := ERR_SYNT;

end

else

begin

lexTmp := MakeTriadList(symbRes,listTriad);

if lexTmp <> nil then

begin

ErrInfo(sErrF,

Format('Семантическая ошибка в строке %d поз. %d!',

[lexTmp.StrNum+1,lexTmp.PosNum]),

lexTmp.PosAll,0);

Result := ERR_TRIAD;

end

else

begin

Result := ERR_NO;

if flTrd then

listTriad.WriteToList(ListTriadAll.Lines);

if flOptC then

begin

OptimizeConst(listTriad);

if flDelC then

DelTriadTypes(listTriad,TRD_CONST);

end;

if flTrd then

listTriad.WriteToList(ListTriadConst.Lines);

if flOptSame then

begin

OptimizeSame(listTriad);

if flDelSame then

DelTriadTypes(listTriad,TRD_SAME);

end;

if flTrd then

listTriad.WriteToList(ListTriadSame.Lines);

iCnt := MakeRegisters(listTriad);

asmList := TStringList.Create;

try

with asmList do

begin

Clear;

Add(#9'pushad {запоминаем регистры}');

MakeAsmCode(listTriad,asmList,flOptAsm);

Add(#9'popad'#9#9'{восстанавливаем регистры}');

end{with};

if flTrd then

ListAsm.Lines.AddStrings(asmList);

if sOutF <> '' then

try

asmList.SaveToFile(sOutF);

except Result := ERR_FILE;

end;

finally asmList.Free;

end{try};

end;

end;

end;

end;

procedure TCursovForm.BtnLoadClick(Sender: TObject);

var

i,iCnt: integer;

iRes: TErrType;

symbRes: TSymbol;

nodeTree: TTreeNode;

begin

symbRes := nil;

InitLexGrid;

TreeSynt.Items.Clear;

iRes := CompRun(

EditFile.Text,'','',{задан только входной файл}

symbRes{указатель на дерево разбора},

True{Списки триад нужно запоминать},

True

{флаг удаления триад "C"},

True

{флаг удаления триад "SAME"},

True{флаг оптимизации по методу

свертки объектного кода },

True{флаг оптимизации исключ.

лишних операций},

true{флаг оптимизации

команд ассемблера});

if iRes > ERR_LEX then

begin

GridLex.RowCount := listLex.Count+1;

iCnt := listLex.Count-1;

for i:=0 to iCnt do

begin

GridLex.Cells[0,i+1] := IntToStr(i+1);

GridLex.Cells[1,i+1] :=

LexTypeName(listLex[i].LexType);

GridLex.Cells[2,i+1] := listLex[i].LexInfoStr;

end;

end;

if (iRes > ERR_SYNT) and (symbRes <> nil) then

begin

nodeTree := TreeSynt.Items.Add(nil,symbRes.SymbolStr);

MakeTree(nodeTree,symbRes);

nodeTree.Expand(True);

TreeSynt.Selected := nodeTree;

end;

if iRes > ERR_TRIAD then

begin

MessageDlg('Компиляция успешно выполнена!',

mtInformation,[mbOk],0);

PageControl1.ActivePageIndex := 4;

end;

end;

procedure TCursovForm.MakeTree(

nodeTree: TTreeNode;

symbSynt: TSymbol;

var

i,iCnt: integer;

nodeTmp: TTreeNode;

begin

iCnt := symbSynt.Count-1;

for i:=0 to iCnt do

begin

nodeTmp := TreeSynt.Items.AddChild(nodeTree,

symbSynt[i].SymbolStr);

if symbSynt[i].SymbType = SYMB_SYNT then

MakeTree(nodeTmp,symbSynt[i]);

end;

end;

procedure TCursovForm.BtnExitClick(Sender: TObject);

begin

Self.Close;

end;

end.

unit FncTree;

interface

uses TblElem;

procedure InitTreeVar;

procedure ClearTreeVar;

procedure ClearTreeInfo;

function AddTreeVar(const sName: string): TVarInfo;

function GetTreeVar(const sName: string): TVarInfo;

function GetTreeCount: integer;

function IdentList(const sLim,sInp,sOut: string): string;

implementation

const

HASH_MIN = Ord('0')+Ord('0');

HASH_MAX = Ord('z')+Ord('z');

var

HashArray : array[HASH_MIN..HASH_MAX] of TVarInfo;

iCmpCount : integer;

function GetTreeCount: integer;

begin

Result := iCmpCount;

end;

function IdentList(const sLim,sInp,sOut: string): string;

var

i: integer;

sAdd: string;

begin

Result := '';

for i:=HASH_MIN to HASH_MAX do

begin

if HashArray[i] = nil then sAdd := ''

else sAdd := HashArray[i].GetElList(sLim,sInp,sOut);

if sAdd <> '' then

begin

if Result <> '' then Result := Result + sLim + sAdd

else Result := sAdd;

end;

end{for};

end;

function VarHash(const sName: string): longint;

begin

Result := (Ord(sName[1])

+ Ord(sName[(Length(sName)+1) div 2])

- HASH_MIN) mod (HASH_MAX-HASH_MIN+1)+HASH_MIN;

if Result < HASH_MIN then Result := HASH_MIN;

end;

procedure InitTreeVar;

var i : integer;

begin

for i:=HASH_MIN to HASH_MAX do HashArray[i] := nil;

end;

procedure ClearTreeVar;

var i : integer;

begin

for i:=HASH_MIN to HASH_MAX do

begin

HashArray[i].Free;

HashArray[i] := nil;

end;

end;

procedure ClearTreeInfo;

var i : integer;

begin

for i:=HASH_MIN to HASH_MAX do

if HashArray[i] <> nil then HashArray[i].ClearAllInfo;

end;

function AddTreeVar(const sName: string): TVarInfo;

var iHash: integer;

begin

iCmpCount := 0;

iHash := VarHash(Upper(sName));

if HashArray[iHash] <> nil then

Result := HashArray[iHash].AddElCnt(sName,iCmpCount)

else

begin

Result := TVarInfo.Create(sName);

HashArray[iHash] := Result;

end;

end;

function GetTreeVar(const sName: string): TVarInfo;

var iHash: integer;

begin

iCmpCount := 0;

iHash := VarHash(Upper(sName));

if HashArray[iHash] = nil then Result := nil

else

Result := HashArray[iHash].FindElCnt(sName,iCmpCount)

end;

initialization

InitTreeVar;

finalization

ClearTreeVar;

end.

unit LexAuto;

interface

uses Classes, TblElem, LexType, LexElem;

function MakeLexList(listFile: TStrings;

listLex: TLexList): integer;

implementation

uses SysUtils, FncTree;

type

TAutoPos = (

AP_START,AP_IF1,AP_IF2,AP_NOT1,AP_NOT2,AP_NOT3,

AP_ELSE1,AP_ELSE2,AP_ELSE3,AP_ELSE4,AP_END2,AP_END3,

AP_PROG1,AP_PROG2,AP_PROG3,AP_PROG4,AP_OR1,AP_OR2,

AP_BEGIN1,AP_BEGIN2,AP_BEGIN3,AP_BEGIN4,AP_BEGIN5,

AP_XOR1,AP_XOR2,AP_XOR3,AP_AND1,AP_AND2,AP_AND3,

AP_WHILE1,AP_WHILE2,AP_WHILE3,AP_WHILE4,AP_WHILE5,

AP_COMM,AP_COMMSG,AP_ASSIGN,AP_VAR,AP_CONST,

AP_DO1,AP_DO2,AP_SIGN,AP_LT,AP_FIN,AP_ERR);

function MakeLexList(listFile: TStrings;

listLex: TLexList): integer;

var

i,j,iCnt,iStr,

iAll,

iStComm,iStart: integer;

posCur: TAutoPos;

sCurStr,sTmp: string;

procedure AddVarToList(posNext: TAutoPos; iP: integer);

begin

sTmp := System.Copy(sCurStr,iStart,iP-iStart);

listLex.Add(TLexem.CreateVar(AddTreeVar(sTmp),

iStComm,i,iStart));

iStart := j;

iStComm := iAll-1;

posCur := posNext;

end;

procedure AddVarKeyToList(keyAdd: TLexType;

posNext: TAutoPos);

begin

sTmp := System.Copy(sCurStr,iStart,j-iStart);

listLex.Add(TLexem.CreateVar(AddTreeVar(sTmp),

iStComm,i,iStart));

listLex.Add(TLexem.CreateKey(keyAdd,iAll,i,j));

iStart := j;

iStComm := iAll-1;

posCur := posNext;

end;

procedure AddConstToList(posNext: TAutoPos; iP: integer);

begin

sTmp := System.Copy(sCurStr,iStart,iP-iStart);

listLex.Add(TLexem.CreateConst(StrToInt(sTmp),

iStComm,i,iStart));

iStart := j;

iStComm := iAll-1;

posCur := posNext;

end;

procedure AddConstKeyToList(keyAdd: TLexType;

posNext: TAutoPos);

begin

sTmp := System.Copy(sCurStr,iStart,j-iStart);

listLex.Add(TLexem.CreateConst(StrToInt(sTmp),iStComm,

i,iStart));

listLex.Add(TLexem.CreateKey(keyAdd,iAll,i,j));

iStart := j;

iStComm := iAll-1;

posCur := posNext;

end;

procedure AddKeyToList(keyAdd: TLexType;

posNext: TAutoPos);

begin

listLex.Add(TLexem.CreateKey(keyAdd,iStComm,i,iStart));

iStart := j;

iStComm := iAll-1;

posCur := posNext;

end;

procedure Add2KeysToList(keyAdd1,keyAdd2: TLexType;

posNext: TAutoPos);

begin

listLex.Add(TLexem.CreateKey(keyAdd1,iStComm,i,iStart));

listLex.Add(TLexem.CreateKey(keyAdd2,iAll,i,j));

iStart := j;

iStComm := iAll-1;

posCur := posNext;

end;

procedure KeyLetter(chNext: char; posNext: TAutoPos);

begin

case sCurStr[j] of

':': AddVarToList(AP_ASSIGN,j);

'-': AddVarKeyToList(LEX_SUB,AP_SIGN);

'+': AddVarKeyToList(LEX_ADD,AP_SIGN);

'=': AddVarKeyToList(LEX_EQ,AP_SIGN);

'>': AddKeyToList(LEX_GT,AP_SIGN);

'<': AddVarToList(AP_LT,j);

'(': AddVarKeyToList(LEX_OPEN,AP_SIGN);

')': AddVarKeyToList(LEX_CLOSE,AP_START);

';': AddVarKeyToList(LEX_SEMI,AP_START);

'{': AddVarToList(AP_COMM,j);

' ',#10,#13,#9: AddVarToList(AP_START,j);

else

if sCurStr[j] = chNext then posCur := posNext

else

if sCurStr[j] in ['0'..'9','A'..'Z','a'..'z','_']

then posCur := AP_VAR

else posCur := AP_ERR;

end{case list};

end;

procedure KeyFinish(keyAdd: TLexType);

begin

case sCurStr[j] of

'-': Add2KeysToList(keyAdd,LEX_UMIN,AP_SIGN);

'+': Add2KeysToList(keyAdd,LEX_ADD,AP_SIGN);

'=': Add2KeysToList(keyAdd,LEX_EQ,AP_SIGN);

'>': Add2KeysToList(keyAdd,LEX_GT,AP_SIGN);

'<': AddKeyToList(keyAdd,AP_LT);

'(': Add2KeysToList(keyAdd,LEX_OPEN,AP_SIGN);

')': Add2KeysToList(keyAdd,LEX_CLOSE,AP_START);

';': Add2KeysToList(keyAdd,LEX_SEMI,AP_START);

'0'..'9','A'..'Z','a'..'z','_': posCur := AP_VAR;

'{': AddKeyToList(keyAdd,AP_COMMSG);

' ',#10,#13,#9: AddKeyToList(keyAdd,AP_SIGN);

else posCur := AP_ERR;

end{case list};

end;

begin

iAll := 0;

Result := 0;

iStComm := 0;

posCur := AP_START;

iCnt := listFile.Count-1;

for i:=0 to iCnt do

begin

iStart := 1;

sCurStr := listFile[i];

iStr := Length(sCurStr);

for j:=1 to iStr do

begin

Inc(iAll);

case posCur of

AP_START:

begin

iStart := j;

iStComm := iAll-1;

case sCurStr[j] of

'b': posCur := AP_BEGIN1;

'i': posCur := AP_IF1;

'p': posCur := AP_PROG1;

'e': posCur := AP_ELSE1;

'w': posCur := AP_WHILE1;

'd': posCur := AP_DO1;

'o': posCur := AP_OR1;

'x': posCur := AP_XOR1;

'a': posCur := AP_AND1;

'n': posCur := AP_NOT1;

':': posCur := AP_ASSIGN;

'-': AddKeyToList(LEX_SUB,AP_SIGN);

'+': AddKeyToList(LEX_ADD,AP_SIGN);

'=': AddKeyToList(LEX_EQ,AP_SIGN);

'>': AddKeyToList(LEX_GT,AP_SIGN);

'<': posCur := AP_LT;

'(': AddKeyToList(LEX_OPEN,AP_SIGN);

')': AddKeyToList(LEX_CLOSE,AP_START);

';': AddKeyToList(LEX_SEMI,AP_START);

'0'..'1': posCur := AP_CONST;

'A'..'Z','c','f'..'h','j'..'m',

'q'..'v','y','z','_': posCur := AP_VAR;

'{': posCur := AP_COMM;

' ',#10,#13,#9: ;

else posCur := AP_ERR;

end{case list};

end;

AP_SIGN:

begin

iStart := j;

iStComm := iAll-1;

case sCurStr[j] of

'b': posCur := AP_BEGIN1;

'i': posCur := AP_IF1;

'p': posCur := AP_PROG1;

'e': posCur := AP_ELSE1;

'w': posCur := AP_WHILE1;

'd': posCur := AP_DO1;

'o': posCur := AP_OR1;

'x': posCur := AP_XOR1;

'a': posCur := AP_AND1;

'n': posCur := AP_NOT1;

'-': AddKeyToList(LEX_UMIN,AP_SIGN);

'(': AddKeyToList(LEX_OPEN,AP_SIGN);

')': AddKeyToList(LEX_CLOSE,AP_START);

'0'..'1': posCur := AP_CONST;

'A'..'Z','c','f'..'h','j'..'m',

'q'..'v','y','z','_': posCur := AP_VAR;

'{': posCur := AP_COMMSG;

' ',#10,#13,#9: ;

else posCur := AP_ERR;

end{case list};

end;

AP_LT:

case sCurStr[j] of

'b': AddKeyToList(LEX_LT,AP_BEGIN1);

'i': AddKeyToList(LEX_LT,AP_IF1);

'p': AddKeyToList(LEX_LT,AP_PROG1);

'e': AddKeyToList(LEX_LT,AP_ELSE1);

'w': AddKeyToList(LEX_LT,AP_WHILE1);

'd': AddKeyToList(LEX_LT,AP_DO1);

'o': AddKeyToList(LEX_LT,AP_OR1);

'x': AddKeyToList(LEX_LT,AP_XOR1);

'a': AddKeyToList(LEX_LT,AP_AND1);

'n': AddKeyToList(LEX_LT,AP_NOT1);

'>': AddKeyToList(LEX_NEQ,AP_SIGN);

'-': Add2KeysToList(LEX_LT,LEX_UMIN,AP_SIGN);

'(': Add2KeysToList(LEX_LT,LEX_OPEN,AP_SIGN);

'0'..'1': AddKeyToList(LEX_LT,AP_CONST);

'A'..'Z','c','f'..'h','j'..'m','q'..'v',

'y','z','_': AddKeyToList(LEX_LT,AP_VAR);

'{': AddKeyToList(LEX_LT,AP_COMMSG);

' ',#10,#13,#9: AddKeyToList(LEX_LT,AP_SIGN);

else posCur := AP_ERR;

end{case list};

AP_ELSE1:

case sCurStr[j] of

'l': posCur := AP_ELSE2;

'n': posCur := AP_END2;

':': AddVarToList(AP_ASSIGN,j);

'-': AddVarKeyToList(LEX_SUB,AP_SIGN);

'+': AddVarKeyToList(LEX_ADD,AP_SIGN);

'=': AddVarKeyToList(LEX_EQ,AP_SIGN);

'>': AddKeyToList(LEX_GT,AP_SIGN);

'<': AddVarToList(AP_LT,j);

'(': AddVarKeyToList(LEX_OPEN,AP_SIGN);

')': AddVarKeyToList(LEX_CLOSE,AP_START);

';': AddVarKeyToList(LEX_SEMI,AP_START);

'{': AddVarToList(AP_COMM,j);

'0'..'9','A'..'Z','a'..'k','m',

'o'..'z','_': posCur := AP_VAR;

' ',#10,#13,#9: AddVarToList(AP_START,j);

else posCur := AP_ERR;

end{case list};

AP_IF1: KeyLetter('f',AP_IF2);

AP_IF2: KeyFinish(LEX_IF);

AP_ELSE2: KeyLetter('s',AP_ELSE3);

AP_ELSE3: KeyLetter('e',AP_ELSE4);

AP_ELSE4: KeyFinish(LEX_ELSE);

AP_OR1: KeyLetter('r',AP_OR2);

AP_OR2: KeyFinish(LEX_OR);

AP_DO1: KeyLetter('o',AP_DO2);

AP_DO2: KeyFinish(LEX_DO);

AP_XOR1: KeyLetter('o',AP_XOR2);

AP_XOR2: KeyLetter('r',AP_XOR3);

AP_XOR3: KeyFinish(LEX_XOR);

AP_AND1: KeyLetter('n',AP_AND2);

AP_AND2: KeyLetter('d',AP_AND3);

AP_AND3: KeyFinish(LEX_AND);

AP_NOT1: KeyLetter('o',AP_NOT2);

AP_NOT2: KeyLetter('t',AP_NOT3);

AP_NOT3: KeyFinish(LEX_NOT);

AP_PROG1: KeyLetter('r',AP_PROG2);

AP_PROG2: KeyLetter('o',AP_PROG3);

AP_PROG3: KeyLetter('g',AP_PROG4);

AP_PROG4: KeyFinish(LEX_PROG);

AP_WHILE1: KeyLetter('h',AP_WHILE2);

AP_WHILE2: KeyLetter('i',AP_WHILE3);

AP_WHILE3: KeyLetter('l',AP_WHILE4);

AP_WHILE4: KeyLetter('e',AP_WHILE5);

AP_WHILE5: KeyFinish(LEX_WHILE);

AP_BEGIN1: KeyLetter('e',AP_BEGIN2);

AP_BEGIN2: KeyLetter('g',AP_BEGIN3);

AP_BEGIN3: KeyLetter('i',AP_BEGIN4);

AP_BEGIN4: KeyLetter('n',AP_BEGIN5);

AP_BEGIN5: KeyFinish(LEX_BEGIN);

AP_END2: KeyLetter('d',AP_END3);

AP_END3:

case sCurStr[j] of

'-': Add2KeysToList(LEX_END,LEX_UMIN,AP_SIGN);

'+': Add2KeysToList(LEX_END,LEX_ADD,AP_SIGN);

'=': Add2KeysToList(LEX_END,LEX_EQ,AP_SIGN);

'>': Add2KeysToList(LEX_END,LEX_GT,AP_SIGN);

'<': AddKeyToList(LEX_END,AP_LT);

'(': Add2KeysToList(LEX_END,LEX_OPEN,AP_SIGN);

')':

Add2KeysToList(LEX_END,LEX_CLOSE,AP_START);

';': Add2KeysToList(LEX_END,LEX_SEMI,AP_START);

'.': AddKeyToList(LEX_FIN,AP_START);

'0'..'9','A'..'Z','a'..'z','_':

posCur := AP_VAR;

'{': AddKeyToList(LEX_END,AP_COMMSG);

' ',#10,#13,#9: AddKeyToList(LEX_END,AP_SIGN);

else posCur := AP_ERR;

end{case list};

AP_ASSIGN:

case sCurStr[j] of

'=': AddKeyToList(LEX_ASSIGN,AP_SIGN);

else posCur := AP_ERR;

end{case list};

AP_VAR:

case sCurStr[j] of

':': AddVarToList(AP_ASSIGN,j);

'-': AddVarKeyToList(LEX_SUB,AP_SIGN);

'+': AddVarKeyToList(LEX_ADD,AP_SIGN);

'=': AddVarKeyToList(LEX_EQ,AP_SIGN);

'>': AddVarKeyToList(LEX_GT,AP_SIGN);

'<': AddVarToList(AP_LT,j);

'(': AddVarKeyToList(LEX_OPEN,AP_SIGN);

')': AddVarKeyToList(LEX_CLOSE,AP_START);

';': AddVarKeyToList(LEX_SEMI,AP_START);

'0'..'9','A'..'Z','a'..'z','_':

posCur := AP_VAR;

'{': AddVarToList(AP_COMM,j);

' ',#10,#13,#9: AddVarToList(AP_START,j);

else posCur := AP_ERR;

end{case list};

AP_CONST:

case sCurStr[j] of

':': AddConstToList(AP_ASSIGN,j);

'-': AddConstKeyToList(LEX_SUB,AP_SIGN);

'+': AddConstKeyToList(LEX_ADD,AP_SIGN);

'=': AddConstKeyToList(LEX_EQ,AP_SIGN);

'>': AddConstKeyToList(LEX_GT,AP_SIGN);

'<': AddConstToList(AP_LT,j);

'(': AddConstKeyToList(LEX_OPEN,AP_SIGN);

')': AddConstKeyToList(LEX_CLOSE,AP_START);

';': AddConstKeyToList(LEX_SEMI,AP_START);

'0'..'1': posCur := AP_CONST;

'{': AddConstToList(AP_COMM,j);

' ',#10,#13,#9: AddConstToList(AP_START,j);

else posCur := AP_ERR;

end{case list};

AP_COMM:

case sCurStr[j] of

'}': posCur := AP_START;

end{case list};

AP_COMMSG:

case sCurStr[j] of

'}': posCur := AP_SIGN;

end{case list};

end{case pos};

if j = iStr then

begin

case posCur of

AP_IF2: AddKeyToList(LEX_IF,AP_SIGN);

AP_PROG4: AddKeyToList(LEX_PROG,AP_START);

AP_ELSE4: AddKeyToList(LEX_ELSE,AP_START);

AP_BEGIN5: AddKeyToList(LEX_BEGIN,AP_START);

AP_WHILE5: AddKeyToList(LEX_WHILE,AP_SIGN);

AP_END3: AddKeyToList(LEX_END,AP_START);

AP_OR2: AddKeyToList(LEX_OR,AP_SIGN);

AP_DO2: AddKeyToList(LEX_DO,AP_SIGN);

AP_XOR3: AddKeyToList(LEX_XOR,AP_SIGN);

AP_AND3: AddKeyToList(LEX_AND,AP_SIGN);

AP_NOT3: AddKeyToList(LEX_AND,AP_SIGN);

AP_LT: AddKeyToList(LEX_LT,AP_SIGN);

AP_FIN: AddKeyToList(LEX_FIN,AP_START);

AP_CONST: AddConstToList(AP_START,j+1);

AP_ASSIGN: posCur := AP_ERR;

AP_IF1,AP_PROG1,AP_PROG2,AP_PROG3,

AP_ELSE1,AP_ELSE2,AP_ELSE3,AP_XOR1,AP_XOR2,

AP_OR1,AP_DO1,AP_AND1,AP_AND2,AP_NOT1,AP_NOT2,

AP_WHILE1,AP_WHILE2,AP_WHILE3,AP_WHILE4,

AP_END2,AP_BEGIN1,AP_BEGIN2,AP_BEGIN3,AP_BEGIN4,

AP_VAR: AddVarToList(AP_START,j+1);

end{case pos2};

end;

if posCur = AP_ERR then

begin

iStart := (j - iStart)+1;

listLex.Insert(0,

TLexem.CreateInfo('Недопустимая лексема',

iAll-iStart,i,iStart));

Break;

end;

end{for j};

Inc(iAll,2);

if posCur = AP_ERR then

begin

Result := i+1;

Break;

end;

end{for i};

if posCur in [AP_COMM,AP_COMMSG] then

begin

listLex.Insert(0,

TLexem.CreateInfo('Незакрытый комментарий',

iStComm,iCnt,iAll-iStComm));

Result := iCnt;

end

else

if not (posCur in [AP_START,AP_SIGN,AP_ERR]) then

begin

listLex.Insert(0,

TLexem.CreateInfo('Незавершенная лексема',

iAll-iStart,iCnt,iStart));

Result := iCnt;

end;

end;

end.

unit LexElem;

interface

uses Classes, TblElem, LexType;

type

TLexInfo = record

case LexType: TLexType of

LEX_VAR: (VarInfo: TVarInfo);

LEX_CONST: (ConstVal: integer);

LEX_START: (szInfo: PChar);

end;

TLexem = class(TObject)

protected

LexInfo: TLexInfo;

iStr,iPos,iAllP: integer;

public

constructor CreateKey(LexKey: TLexType;

iA,iSt,iP: integer);

constructor CreateVar(VarInf: TVarInfo;

iA,iSt,iP: integer);

constructor CreateConst(iVal: integer;

iA,iSt,iP: integer);

constructor CreateInfo(sInf: string;

iA,iSt,iP: integer);

destructor Destroy; override;

property LexType: TLexType read LexInfo.LexType;

property VarInfo: TVarInfo read LexInfo.VarInfo;

property ConstVal: integer read LexInfo.ConstVal;

property StrNum: integer read iStr;

property PosNum: integer read iPos;

property PosAll: integer read iAllP;

function LexInfoStr: string;

function VarName: string;

end;

TLexList = class(TList)

public

destructor Destroy; override;

procedure Clear; override;

function GetLexem(iIdx: integer): TLexem;

property Lexem[iIdx: integer]: TLexem read GetLexem;

default;

end;

implementation

uses SysUtils, LexAuto;

constructor TLexem.CreateKey(LexKey: TLexType;

iA,iSt,iP: integer);

begin

inherited Create;

LexInfo.LexType := LexKey;

iStr := iSt;

iPos := iP;

iAllP := iA;

end;

constructor TLexem.CreateVar(VarInf: TVarInfo;

iA,iSt,iP: integer);

begin

inherited Create;

LexInfo.LexType := LEX_VAR;

LexInfo.VarInfo := VarInf;

iStr := iSt;

iPos := iP;

iAllP := iA;

end;

constructor TLexem.CreateConst(iVal: integer;

iA,iSt,iP: integer);

begin

inherited Create;

LexInfo.LexType := LEX_CONST;

LexInfo.ConstVal := iVal;

iStr := iSt;

iPos := iP;

iAllP := iA;

end;

constructor TLexem.CreateInfo(sInf: string;

iA,iSt,iP: integer)

begin

inherited Create;

LexInfo.LexType := LEX_START;

LexInfo.szInfo := StrAlloc(Length(sInf)+1);

StrPCopy(LexInfo.szInfo,sInf);

iStr := iSt;

iPos := iP;

iAllP := iA;

end;

destructor TLexem.Destroy;

begin

if LexType = LEX_START then StrDispose(LexInfo.szInfo);

inherited Destroy;

end;

function TLexem.VarName: string;

begin

Result := VarInfo.VarName;

end;

function TLexem.LexInfoStr: string;

begin

case LexType of

LEX_VAR: Result := VarName;

LEX_CONST: Result := IntToStr(ConstVal);

LEX_START: Result := StrPas(LexInfo.szInfo);

else Result := LexTypeInfo(LexType);

end;

end;

procedure TLexList.Clear;

var i: integer;

begin

for i:=Count-1 downto 0 do Lexem[i].Free;

inherited Clear;

end;

destructor TLexList.Destroy;

begin

Clear;

inherited Destroy;

end;

function TLexList.GetLexem(iIdx: integer): TLexem;

begin

Result := TLexem(Items[iIdx]);

end;

end.

unit LexType;

interface

type

TLexType =

(LEX_PROG, LEX_FIN, LEX_SEMI, LEX_IF, LEX_OPEN, LEX_CLOSE,

LEX_ELSE, LEX_BEGIN, LEX_END, LEX_WHILE, LEX_DO, LEX_VAR,

LEX_CONST, LEX_ASSIGN, LEX_OR, LEX_XOR, LEX_AND,

LEX_LT, LEX_GT, LEX_EQ, LEX_NEQ, LEX_NOT,

LEX_SUB, LEX_ADD, LEX_UMIN, LEX_START);

function LexTypeName(lexT: TLexType): string;

function LexTypeInfo(lexT: TLexType): string;

implementation

function LexTypeName(lexT: TLexType): string;

begin

case lexT of

LEX_OPEN: Result := 'Открывающая скобка';

LEX_CLOSE: Result := 'Закрывающая скобка';

LEX_ASSIGN: Result := 'Знак присвоения';

LEX_VAR: Result := 'Переменная';

LEX_CONST: Result := 'Константа';

LEX_SEMI: Result := 'Разделитель';

LEX_ADD,LEX_SUB,LEX_UMIN,LEX_GT,LEX_LT,LEX_EQ,

LEX_NEQ: Result := 'Знак операции';

else Result := 'Ключевое слово';

end;

end;

function LexTypeInfo(lexT: TLexType): string;

begin

case lexT of

LEX_PROG: Result := 'prog';

LEX_FIN: Result := 'end.';

LEX_SEMI: Result := ';';

LEX_IF: Result := 'if';

LEX_OPEN: Result := '(';

LEX_CLOSE: Result := ')';

LEX_ELSE: Result := 'else';

LEX_BEGIN: Result := 'begin';

LEX_END: Result := 'end';

LEX_WHILE: Result := 'while';

LEX_DO: Result := 'do';

LEX_VAR: Result := 'a';

LEX_CONST: Result := 'c';

LEX_ASSIGN: Result := ':=';

LEX_OR: Result := 'or';

LEX_XOR: Result := 'xor';

LEX_AND: Result := 'and';

LEX_LT: Result := '<';

LEX_GT: Result := '>';

LEX_EQ: Result := '=';

LEX_NEQ: Result := '<>';

LEX_NOT: Result := 'not';

LEX_ADD: Result := '+';

LEX_SUB,

LEX_UMIN: Result := '-';

else Result := '';

end;

end;

end.

unit SyntRule;

interface

uses LexType, Classes;

const

RULE_LENGTH = 7;

RULE_NUM = 28;

var

GramMatrix: array[TLexType,TLexType] of char =

( {pr. end. ; if ( ) else beg end whl do a c := or xor and < > = <> not - + um ! }

{pr.} (' ','=','<','<',' ',' ',' ','<',' ','<',' ','<',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),

{end.}(' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ','>'),

{;} (' ','>','>','<',' ',' ',' ','<','>','<',' ','<',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),

{if} (' ',' ',' ',' ','=',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),

{(} (' ',' ',' ',' ','<','=',' ',' ',' ',' ',' ','<','<',' ','<','<','<','<','<','<','<','<','<','<','<',' '),

{)} (' ','>','>','<',' ','>','=','<','>','<','=','<',' ',' ','>','>','>','>','>','>','>',' ','>','>',' ',' '),

{else}(' ','>','>','<',' ',' ','>','<','>','<',' ','<',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),

{beg.}(' ',' ','<','<',' ',' ',' ','<','=','<',' ','<',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),

{end} (' ','>','>',' ',' ',' ','>',' ','>',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),

{whil}(' ',' ',' ',' ','=',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),

{do} (' ','>','>','<',' ',' ','>','<','<','<',' ','<',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),

{a} (' ','>','>',' ',' ','>','>',' ','>',' ',' ',' ',' ','=','>','>','>','>','>','>','>',' ','>','>',' ',' '),

{c} (' ','>','>',' ',' ','>','>',' ','>',' ',' ',' ',' ',' ','>','>','>','>','>','>','>',' ','>','>',' ',' '),

{:=} (' ','>','>',' ','<',' ','>',' ','>',' ',' ','<','<',' ',' ',' ',' ',' ',' ',' ',' ',' ','<','<','<',' '),

{or} (' ',' ',' ',' ','<','>',' ',' ',' ',' ',' ','<','<',' ','>','>','<','<','<','<','<','<','<','<','<',' '),

{xor} (' ',' ',' ',' ','<','>',' ',' ',' ',' ',' ','<','<',' ','>','>','<','<','<','<','<','<','<','<','<',' '),

{and} (' ',' ',' ',' ','<','>',' ',' ',' ',' ',' ','<','<',' ','>','>','>','<','<','<','<','<','<','<','<',' '),

{<} (' ',' ',' ',' ','<','>',' ',' ',' ',' ',' ','<','<',' ','>','>','>',' ',' ',' ',' ',' ','<','<','<',' '),

{>} (' ',' ',' ',' ','<','>',' ',' ',' ',' ',' ','<','<',' ','>','>','>',' ',' ',' ',' ',' ','<','<','<',' '),

{=} (' ',' ',' ',' ','<','>',' ',' ',' ',' ',' ','<','<',' ','>','>','>',' ',' ',' ',' ',' ','<','<','<',' '),

{<>} (' ',' ',' ',' ','<','>',' ',' ',' ',' ',' ','<','<',' ','>','>','>',' ',' ',' ',' ',' ','<','<','<',' '),

{not} (' ',' ',' ',' ','=',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),

{-} (' ','>','>',' ','<','>','>',' ','>',' ',' ','<','<',' ','>','>','>','>','>','>','>',' ','>','>','<',' '),

{+} (' ','>','>',' ','<','>','>',' ','>',' ',' ','<','<',' ','>','>','>','>','>','>','>',' ','>','>','<',' '),

{um} (' ','>','>',' ','<','>','>',' ','>',' ',' ','<','<',' ','>','>','>','>','>','>','>',' ','>','>','<',' '),

{!} ('<',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '));

GramRules: array[1..RULE_NUM] of string =

('progEend.','E','E;E','E;','if(B)EelseE','if(B)E',

'beginEend','while(B)doE','a:=E','BorB','BxorB','B',

'BandB','B','E<E','E>E','E=E','E<>E','(B)','not(B)',

'E-E','E+E','E','-E','E','(E)','a','c');

function MakeSymbolStr(iRuleNum: integer): string;

function CorrectRule(cRule: char; lexTop,lexCur: TLexType;

symbStack: TList): char;

implementation

uses SyntSymb;

function MakeSymbolStr(iRuleNum: integer): string;

begin

if iRuleNum in [10..20] then Result := 'B'

else Result := 'E';

end;

function CorrectRule(cRule: char; lexTop,lexCur: TLexType;

symbStack: TList): char;

var j: integer;

begin

Result := cRule;

if (cRule = '=') and (lexTop = LEX_CLOSE)

and (lexCur = LEX_ELSE) then

begin

j := TSymbStack(symbStack).Count-1;

if (j > 2)

and (TSymbStack(symbStack)[j-2].SymbolStr <> 'B')

then Result := '>';

end;

end;

end.

unit SyntSymb;

interface

uses Classes, LexElem, SyntRule;

type

TSymbKind = (SYMB_LEX, SYMB_SYNT);

TSymbInfo = record

case SymbType: TSymbKind of

SYMB_LEX: (LexOne: TLexem);

SYMB_SYNT: (LexList: TList);

end;

TSymbol = class;

TSymbArray = array[0..RULE_LENGTH] of TSymbol;

TSymbol = class(TObject)

protected

SymbInfo: TSymbInfo;

iRuleNum: integer;

public

constructor CreateLex(Lex: TLexem);

constructor CreateSymb(iR,iSymbN: integer;

const SymbArr: TSymbArray);

destructor Destroy; override;

function GetItem(iIdx: integer): TSymbol;

function Count: integer;

function SymbolStr: string;

property SymbType: TSymbKind read SymbInfo.SymbType;

property Lexem: TLexem read SymbInfo.LexOne;

property Items[iIdx: integer]: TSymbol read GetItem;

default;

property Rule: integer read iRuleNum;

end;

TSymbStack = class(TList)

public

destructor Destroy; override;

procedure Clear; override;

function GetSymbol(iIdx: integer): TSymbol;

function Push(lex: TLexem): TSymbol;

property Symbols[iIdx: integer]: TSymbol read GetSymbol;

default;

function TopLexem: TLexem;

function MakeTopSymb: TSymbol;

end;

function BuildSyntList(const listLex: TLexList;

symbStack: TSymbStack): TSymbol;

implementation

uses LexType, LexAuto;

constructor TSymbol.CreateLex(Lex: TLexem);

begin

inherited Create;

SymbInfo.SymbType := SYMB_LEX;

SymbInfo.LexOne := Lex;

iRuleNum := 0;

end;

constructor TSymbol.CreateSymb(iR{номер правила},

iSymbN{кол-во исходных символов}: integer;

const SymbArr: TSymbArray{массив исходных символов});

var i: integer;

begin

inherited Create;

SymbInfo.SymbType := SYMB_SYNT;

SymbInfo.LexList := TList.Create;

for i:=iSymbN-1 downto 0 do

SymbInfo.LexList.Add(SymbArr[i]);

iRuleNum := iR;

end;

function TSymbol.GetItem(iIdx: integer): TSymbol;

begin

Result := TSymbol(SymbInfo.LexList[iIdx])

end;

function TSymbol.Count: integer;

begin

Result := SymbInfo.LexList.Count;

end;

function TSymbol.SymbolStr: string;

begin

if SymbType = SYMB_SYNT then