Створення компілятора

    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;

{ Начальная инициализация  хэш-таблицы -

  все элементы пустые }