Курсовой проект / 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.