Курсовой проект / Cursov / FormLab4

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;
{ Вызываем функцию компиляции }
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.