1. FormLab

unit FormLab4;

interface

uses

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

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

LexElem, SyntSymb, Triads;

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;

CheckDel_C: TCheckBox;

CheckDelSame: TCheckBox;

SheetAsm: TTabSheet;

ListAsm: TMemo;

CheckAsm: TCheckBox;

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

{ Чтение файла в список строк }

ListIdents.Lines.LoadFromFile(sInF);

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);

{ Если указан флаг, удаляем триады типа "C" }

if flDelC then

DelTriadTypes(listTriad,TRD_CONST);

end;

{ Если указан флаг, сохраняем

список триад после оптимизации }

if flTrd then

listTriad.WriteToList(ListTriadConst.Lines);

{ Если указан флаг, выполняем оптимизацию

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

if flOptSame then

begin

OptimizeSame(listTriad);

{ Если указан флаг, удаляем триады типа "SAME" }

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(Format('program %s;',[NAME_PROG]));

{ Запоминаем перечень всех идентификаторов }

sVars := IdentList(',',NAME_INPVAR,NAME_FUNCT);

if sVars <> '' then

begin

{ Если перечень идентификаторов не пустой,

записываем его с указанием типа данных }

Add('');

Add('var');

Add(Format(' %s: %s;',[sVars,NAME_TYPE]));

end;

Add('');

{ Пишем заголовок функции }

Add(Format('function %0:s(%1:s: %2:s): %2:s;'

+' stdcall;',

[NAME_FUNCT,NAME_INPVAR,NAME_TYPE]));

{ Если регистров для хранения промежуточных

результатов не хватило и нужны временные

переменные, то заполняем их список }

if iCnt > 0 then

begin

Add('var');

sVars := '';

for i:=0 to iCnt do

begin

sAdd := Format('%s%d',[TEMP_VARNAME,i]);

if sVars = '' then sVars := sAdd

else sVars := sVars +','+ sAdd;

end;

Add(Format(' %s: %s;',[sVars,NAME_TYPE]));

end;

{ В тело функции записываем созданный список

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

Add('begin');

Add(' asm');

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

MakeAsmCode(listTriad,asmList,flOptAsm);

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

Add(' end;');

Add('end;');

Add('');

{ Описываем одну входную переменную }

Add(Format('var %s: %s;',

[NAME_INPVAR,NAME_TYPE]));

Add('');

{ Заполняем тело главной программы }

Add('begin');

Add(Format(' readln(%s);',[NAME_INPVAR]));

Add(Format(' writeln(%s(%s));',

[NAME_FUNCT,NAME_INPVAR]));

Add(' readln;');

Add('end.');

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;

ListAsm.Clear;

{ Вызываем функцию компиляции }

iRes := CompRun(

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

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

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

CheckDel_C.Checked

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

CheckDelSame.Checked

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

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

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

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

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

CheckAsm.Checked{флаг оптимизации

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

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.

2. FncTree

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.

3. TblElem

unit TblElem;

interface

{ Модуль, описывающий структуру данных элементов

таблицы идентификаторов }

type

{ Класс для описания некоторых данных,

связанных с элементом таблицы }

TAddVarInfo = class(TObject)

public

procedure SetInfo(iIdx: integer; iInfo: longint);

virtual; abstract;

function GetInfo(iIdx: integer): longint;

virtual; abstract;

property Info[iIdx: integer]: longint

read GetInfo write SetInfo; default;

end;

{ Класс для описания элемента хэш-таблицы }

TVarInfo = class(TObject)

protected

{ Имя элемента }

sName: string;

{ Дополнительная информация (для будущего использования)}

pInfo: TAddVarInfo;

{ Ссылки на меньший и больший элементы

для организации бинарного дерева }

minEl,maxEl: TVarInfo;

public

{ Конструктор создания элемента хэш-таблицы }

constructor Create(const sN: string);

{ Деструктор для освобождения памяти, занятой элементом }

destructor Destroy; override;

{ Функция заполнения дополнительной информации элемента }

procedure SetInfo(pI: TAddVarInfo);

{ Функции для удаления дополнительной информации }

procedure ClearInfo;

procedure ClearAllInfo;

{ Свойство "Имя элемента" }

property VarName: string read sName;

{ Свойство "Дополнительная информация"

(для будущего использования) }

property Info: TAddVarInfo read pInfo write SetInfo;

{ Функции для добавления элемента в бинарное дерево }

function AddElCnt(const sAdd: string;

var iCnt: integer): TVarInfo;

function AddElem(const sAdd: string): TVarInfo;

{ Функции для поиска элемента в бинарном дереве }

function FindElCnt(const sN: string;

var iCnt: integer): TVarInfo;

function FindElem(const sN: string): TVarInfo;

{ Функция записи всех имен идентификаторов

в одну строку }

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

end;

function Upper(const x:string): string;

implementation

uses SysUtils;

{ Условная компиляция: если определено имя REGNAME,

то имена переменных считаются регистрозависимыми,

иначе - регистронезависимыми }

{$IFDEF REGNAME}

function Upper(const x:string): string;

begin Result := UpperCase(x); end;

{$ELSE}

function Upper(const x:string): string;

begin Result := x; end;

{$ENDIF}

constructor TVarInfo.Create(const sN: string);

{ Конструктор создания элемента хэш-таблицы }

begin

{ Вызываем конструктор базового класса TObject }

inherited Create;

{ Запоминаем имя элемента и обнуляем все ссылки }

sName := sN;

pInfo := nil;

minEl := nil;

maxEl := nil;

end;

destructor TVarInfo.Destroy;

{ Деструктор для освобождения памяти, занятой элементом }

begin

{ Освобождаем память по каждой ссылке

(если она не нулевая), при этом в дереве рекурсивно

будет освобождена память для всех элементов }

ClearAllInfo;

minEl.Free;

maxEl.Free;

{ Вызываем деструктор базового класса TObject }

inherited Destroy;

end;

function TVarInfo.GetElList(const sLim{разделитель списка},

sInp,sOut{имена, не включаемые в строку}: string): string;

{ Функция записи всех имен идентификаторов в одну строку }

var sAdd: string;

begin

{ Первоначально строка пуста }

Result := '';

{ Если элемент таблицы не совпадает с одним

из невключаемых имен, то его нужно включить в строку }

if (Upper(sName) <> Upper(sInp))

and (Upper(sName) <> Upper(sOut)) then Result := sName;

{ Если есть левая ветвь дерева }

if minEl <> nil then

begin

{ Вычисляем строку для этой ветви }

sAdd := minEl.GetElList(sLim,sInp,sOut);

{ Если она не пустая, добавляем ее через разделитель }

if sAdd <> '' then

begin

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

else Result := sAdd;

end;

end;

{ Если есть правая ветвь дерева }

if maxEl <> nil then

begin

{ Вычисляем строку для этой ветви }

sAdd := maxEl.GetElList(sLim,sInp,sOut);

{ Если она не пустая, добавляем ее через разделитель }

if sAdd <> '' then

begin

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

else Result := sAdd;

end;

end;

end;

procedure TVarInfo.SetInfo(pI: TAddVarInfo);

{ Функция заполнения дополнительной информации элемента }

begin

pInfo := pI;

end;

procedure TVarInfo.ClearInfo;

{ Функция удаления дополнительной информации элемента }

begin

pInfo.Free;

pInfo := nil;

end;

procedure TVarInfo.ClearAllInfo;

{ Функция удаления дополнительной информации элемента

и его связок }

begin

if minEl <> nil then minEl.ClearAllInfo;

if maxEl <> nil then maxEl.ClearAllInfo;

pInfo.Free;

pInfo := nil;

end;

function TVarInfo.AddElCnt(const sAdd: string;

var iCnt: integer): TVarInfo;

{ Функция добавления элемента в бинарное дерево

с учетом счетчика сравнений }

var i: integer;

begin

{ Увеличиваем счетчик сравнений }

Inc(iCnt);

{ Сравниваем имена нового и текущего элемента

(одной функцией!) }

i := StrComp(PChar(Upper(sAdd)),PChar(Upper(sName)));

if i < 0 then

{ Если новый элемент меньше, смотрим ссылку

на меньший элемент }

begin

{ Если ссылка не пустая, рекурсивно вызываем функцию

добавления элемента }

if minEl <> nil then

Result := minEl.AddElCnt(sAdd,iCnt)

else

{ Если ссылка пустая, создаем новый элемент

и запоминаем ссылку на него }

begin

Result := TVarInfo.Create(sAdd);

minEl := Result;

end;

end

else

{ Если новый элемент больше, смотрим ссылку

на больший элемент }

if i > 0 then

begin

{ Если ссылка не пустая, рекурсивно вызываем функцию

добавления элемента }

if maxEl <> nil then

Result := maxEl.AddElCnt(sAdd,iCnt)

else

{ Если ссылка пустая, создаем новый элемент

и запоминаем ссылку на него }

begin

Result := TVarInfo.Create(sAdd);

maxEl := Result;

end;

end

{ Если имена совпадают, то такой элемент уже есть

в дереве - это текущий элемент }

else Result := Self;

end;

function TVarInfo.AddElem(const sAdd: string): TVarInfo;

{ Функция добавления элемента в бинарное дерево

без учета счетчика сравнений }

var iCnt: integer;

begin

Result := AddElCnt(sAdd,iCnt);

end;

function TVarInfo.FindElCnt(const sN: string;

var iCnt: integer): TVarInfo;

{ Функция поиска элемента в бинарном дереве

с учетом счетчика сравнений }

var i: integer;

begin

{ Увеличиваем счетчик сравнений }

Inc(iCnt);

{ Сравниваем имена искомого и текущего элемента

(одной функцией!) }

i := StrComp(PChar(Upper(sN)),PChar(Upper(sName)));

if i < 0 then

{ Если искомый элемент меньше, смотрим ссылку

на меньший элемент }

begin

{ Если ссылка не пустая, рекурсивно вызываем для нее

функцию поиска элемента, иначе элемент не найден }

if minEl <> nil then Result := minEl.FindElCnt(sN,iCnt)

else Result := nil;

end

else

if i > 0 then

{ Если искомый элемент больше, смотрим ссылку

на больший элемент }

begin

{ Если ссылка не пустая, рекурсивно вызываем для нее

функцию поиска элемента, иначе элемент не найден }

if maxEl <> nil then Result := maxEl.FindElCnt(sN,iCnt)

else Result := nil;

end

{ Если имена совпадают, то искомый элемент

найден - это текущий элемент }

else Result := Self;

end;

function TVarInfo.FindElem(const sN: string): TVarInfo;

{ Функция поиска элемента в бинарном дереве

без учета счетчика сравнений }

var iCnt: integer;

begin

Result := FindElCnt(sN,iCnt);

end;

end.

4. LexElem

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

{ Конструкторы для создания лексем разных типов}