Модуль структуры данных для таблицы идентификаторов

Следует обратить внимание, что функция Upper в листинге П3.1 построена на основе условной компиляции:

• если при компиляции определено имя «REGNAME», то таблицы идентификаторов строятся на основе имен переменных, не зависящих от регистра символов (прописные и строчные буквы не различаются);

• если при компиляции имя «REGNAME» не определено, то таблицы идентификаторов строятся на основе имен переменных, зависящих от регистра символов (прописные и строчные буквы различаются).

Листинг П3.1. Описание структуры данных для элементов таблицы идентификаторов

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

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

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

sName:= sN; pInfo:= nil;

minEl:= nil; maxEl:= nil;

end;

destructor TVarInfo.Destroy;

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

begin

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

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

ClearAllInfo;

minEl.Free; maxEl.Free;

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;

ClearInfo;

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.

 

Модуль таблицы идентификаторов на основе хэш-адресации в комбинации с бинарным деревом

Листинг П3.2. Модуль таблицы идентификаторов на основе хэш-адресации в комбинации с бинарным деревом

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]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
)

+ 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 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.

 

Модуль описания структуры элементов таблицы лексем

Листинг П3.4. Описание структуры элементов таблицы лексем

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[i: 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.

 

Модуль заполнения таблицы лексем по исходному тексту программы

Листинг П3.5. Заполнение таблицы лексем по исходному тексту программы

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; { Обнуляем результат функции }

posCur:= AP_START;{Устанавливаем начальное состояние КА}

iStComm:= 0; 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.. 9 : 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.. 9 : 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.. 9 : 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: { «else», или же «end», или переменная? }

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: { «end», или же «end.», или переменная? }

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.. 9 : 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); { В конце строки увеличиваем общий счетчик

cимволов на 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.

 

Модуль описания матрицы предшествования и правил исходной грамматики

Листинг П3.6. Описание матрицы предшествования и правил исходной грамматики

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','EE','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 { Корректируем отношение для символа «else»,

если в стеке не логическое выражение }

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.

 

Модуль описания структур данных синтаксического анализатора и реализации алгоритма «сдвиг-свертка»

Листинг П3.7. Описание структур данных синтаксического анализатора и реализация алгоритма «сдвиг-свертка»

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[i: 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; { Правило не используется, поэтому «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

Result:= MakeSymbolStr(iRuleNum)

{ Если это терминальный символ, формируем его

представление в соответствии с типом лексемы }

else Result:= Lexem.LexInfoStr;

end;

destructor TSymbol.Destroy;

{ Деструктор для удаления символа }

var i: integer;

begin

if SymbInfo.SymbType = SYMB_SYNT then

with SymbInfo.LexList do

begin { Если это нетерминальный символ, }

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

for i:=Count-1 downto 0 do TSymbol(Items[i]). Free;

Free; { Удаляем сам список символов }

end;

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

end;

destructor TSymbStack.Destroy;

{ Деструктор для удаления синтаксического стека }

begin

Clear; { Очищаем стек }

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

end;

procedure TSymbStack.Clear;

{ Функция очистки синтаксического стека }

var i: integer;

begin { Удаляем все символы из стека }

for i:=Count-1 downto 0 do TSymbol(Items[i]). Free;

inherited Clear; { Вызываем функцию базового класса }

end;

function TSymbStack.GetSymbol(iIdx: integer): TSymbol;

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

begin Result:= TSymbol(Items[iIdx]); end;

function TSymbStack.TopLexem: TLexem;

{ Функция, возвращающая самую верхнюю лексему в стеке }

var i: integer;

begin

Result:= nil; { Начальный результат функции пустой }

for i:=Count-1 downto 0 do{Для символов от вершины стека}

if Symbols[i].SymbType = SYMB_LEX then

begin { Если это терминальный символ }

Result:= Symbols[i].Lexem; {Берем ссылку на лексему}

Break; { Прекращаем поиск }

end;

end;

function TSymbStack.Push(lex: TLexem): TSymbol;

{ Функция помещения лексемы в синтаксический стек }

begin { Создаем новый терминальный символ }

Result:= TSymbol.CreateLex(lex);

Add(Result); { Добавляем его в стек }

end;

function TSymbStack.MakeTopSymb: TSymbol;

{ Функция, выполняющая свертку. Результат функции:

nil – если не удалось выполнить свертку, иначе – ссылка

на новый нетерминальный символ (если свертка выполнена).}

var

symCur: TSymbol; {Текущий символ стека}

SymbArr: TSymbArray;{Массив хранения символов правила}

i,iSymbN: integer;{Счетчики символов в стеке и в правиле}

sRuleStr: string; {Строковое представление правила}

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

procedure AddToRule(const sStr: string;{Строка символа}

sym: TSymbol{Тек. символ});

begin

symCur:= sym; { Устанавливаем ссылку на текущий символ }

{ Добавляем очередной символ в массив символов правила }

SymbArr[iSymbN]:= Symbols[i];

{ Добавляем его в строку правила (слева!) }

sRuleStr:= sStr + sRuleStr;

Delete(i); { Удаляем символ из стека }

Inc(iSymbN); { Увеличиваем счетчик символов в правиле }

end;

begin

Result:= nil; { Сначала обнуляем результат функции }

iSymbN:= 0; { Сбрасываем счетчик символов }

symCur:= nil; { Обнуляем текущий символ }

sRuleStr:= ; { Сначала строка правила пустая }

for i:=Count-1 downto 0 do{ Выполняем алгоритм }

begin { Для всех символов начиная с вершины стека }

if Symbols[i].SymbType = SYMB_SYNT then

{ Если это нетерминальный символ, то добавляем его

в правило, текущий символ при этом не меняется }

AddToRule(Symbols[i].SymbolStr,symCur)

else { Если это терминальный символ }

if symCur = nil then {и текущий символ пустой }

{ Добавляем его в правило и делаем текущим }

AddToRule(LexTypeInfo(Symbols[i].Lexem.LexType),

Symbols[i])

else { Если это терминальный символ и он связан

отношением "=" с текущим символом }

if GramMatrix[Symbols[i].Lexem.LexType,

symCur.Lexem.LexType] = = then

{ Добавляем его в правило и делаем текущим }

AddToRule(LexTypeInfo(Symbols[i].Lexem.LexType),

Symbols[i])

else { Иначе – прерываем цикл, дальше искать не нужно }

Break;

if iSymbN > RULE_LENGTH then Break; { Если превышена

максимальная длина правила, цикл прекращаем }

end;

if iSymbN <> 0 then

begin { Если выбран хотя бы один символ из стека, то

ищем простым перебором правило, у которого строковое

представление совпадает с построенной строкой }

for i:=1 to RULE_NUM do

if GramRules[i] = sRuleStr then{Если правило найдено,}

begin { создаем новый нетерминальный символ }

Result:= TSymbol.CreateSymb(i,iSymbN,SymbArr);

Add(Result); { и добавляем его в стек. }

Break; { Прерываем цикл поиска правил }

end;

{ Если не был создан новый символ (правило не найдено),

надо удалить все исходные символы, это ошибка }

if Result = nil then

for i:=0 to iSymbN-1 do SymbArr[i].Free;

end;

end;

function BuildSyntList(

const listLex: TLexList{входная таблица лексем};

symbStack: TSymbStack{стек для работы алгоритма}

): TSymbol;

{ Функция, выполняющая алгоритм «сдвиг-свертка».

Результат функции:

– нетерминальный символ (корень синтаксического дерева),

если разбор был выполнен успешно;

– терминальный символ, ссылающийся на лексему, где была

обнаружена ошибка, если разбор выполнен с ошибками. }

var

i,iCnt: integer; {счетчик лексем и длина таблицы лексем}

lexStop: TLexem; { Ссылка на начальную лексему }

lexTCur: TLexType; { Тип текущей лексемы }

cRule: char;{ Текущее отношение предшествования }

begin

Result:= nil; { Сначала результат функции пустой }

iCnt:= listLex.Count-1; { Берем длину таблицы лексем }

{ Создаем дополнительную лексему «начало строки» }

lexStop:= TLexem.CreateInfo('Начало файла',0,0,0);

try { Помещаем начальную лексему в стек }

symbStack.Push(lexStop);

i:= 0; { Обнуляем счетчик входных лексем }

while i<=iCnt do { Цикл по всем лексемам от начала }

begin { до конца таблицы лексем }

{ Получаем тип лексемы на вершине стека }

lexTCur:= symbStack.TopLexem.LexType;

{ Если на вершине стека начальная лексема,

а текущая лексема – конечная, то разбор завершен }

if (lexTCur = LEX_START)

and (listLex[i].LexType = LEX_START) then Break;

{ Смотрим отношение лексемы на вершине стека

и текущей лексемы в строке }

cRule:= GramMatrix[lexTCur,listLex[i].LexType];

{ Корректируем отношение. Если корректировка матрицы

предшествования не используется, то функция должна

вернуть то же самое отношение }

cRule:= CorrectRule(cRule,lexTCur,

listLex[i].LexType,symbStack);

case cRule of

'<, =: { Надо выполнять сдвиг (перенос) }

begin { Помещаем текущую лексему в стек }

symbStack.Push(listLex[i]);

Inc(i); { Увеличиваем счетчик входных лексем }

end;

'>: { Надо выполнять свертку }

if symbStack.MakeTopSymb = nil then

begin { Если не удалось выполнить свертку, }

{ запоминаем текущую лексему как место ошибки }

Result:= TSymbol.CreateLex(listLex[i]);

Break; { Прерываем алгоритм }

end;

else { Отношение не установлено – ошибка разбора }

begin {Запоминаем текущую лексему (место ошибки)}

Result:= TSymbol.CreateLex(listLex[i]);

Break; { Прерываем алгоритм }

end;

end{case};

end{while};

if Result = nil then { Если разбор прошел без ошибок }

begin{Убеждаемся, что в стеке осталось только 2 символа}

if symbStack.Count = 2 then

{ Если да, то верхний символ – результат разбора }

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

{ Иначе это ошибка – отмечаем место ошибки }

else Result:= TSymbol.CreateLex(listLex[iCnt]);

end;

finally { Уничтожаем временную начальную лексему }

lexStop.Free;

end;

end;

end.

 

Модуль описания допустимых типов триад

Листинг П3.8. Описание допустимых типов триад

unit TrdType; {!!! Зависит от входного языка!!!}

interface

{ Модуль для описания допустимых типов триад }

const { Имена предопределенных функций и переменных }

NAME_PROG = 'MyCurs';

NAME_INPVAR = 'InpVar';

NAME_RESULT = 'Result';

NAME_FUNCT = 'CompileTest';

NAME_TYPE = 'integer';

type { Типы триад, соответствующие типам допустимых

операций, а также три дополнительных типа триад:

– CONST – для алгоритма свертки объектного кода;

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

– NOP (No OPerations) – для ссылок на конец списка триад. }

TTriadType = (TRD_IF,TRD_OR,TRD_XOR,TRD_AND,TRD_NOT,

TRD_LT,TRD_GT,TRD_EQ,TRD_NEQ,TRD_ADD,TRD_SUB,TRD_UMIN,

TRD_ASSIGN,TRD_JMP,TRD_CONST,TRD_SAME,TRD_NOP);

{Массив строковых обозначений триад для вывода их на экран}

TTriadStr = array[TTriadType] of string;

const TriadStr: TTriadStr =('if','or','xor','and','not',

'<, >, =, <>, +, -, -,

':=,'jmp','C','same','nop');

{ Множество триад, которые являются линейными операциями }

TriadLineSet: set of TTriadType =

[TRD_OR, TRD_XOR, TRD_AND, TRD_NOT, TRD_ADD, TRD_SUB,

TRD_LT, TRD_GT, TRD_EQ, TRD_NEQ, TRD_UMIN];

implementation

end.

 

Модуль вычисления значений триад при свертке объектного кода

Листинг П3.9. Вычисление значений триад при свертке объектного кода

unit TrdCalc; {!!! Зависит от входного языка!!!}

interface

{ Модуль, вычисляющий значения триад при свертке операций }

uses TrdType;

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

function CalcTriad(Triad: TTriadType;

iOp1,iOp2: integer): integer;

implementation

function CalcTriad(Triad: TTriadType;

iOp1,iOp2: integer): integer;

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

begin

Result:= 0;

case Triad of

TRD_OR: Result:= (iOp1 or iOp2) and 1;

TRD_XOR: Result:= (iOp1 xor iOp2) and 1;

TRD_AND: Result:= (iOp1 and iOp2) and 1;

TRD_NOT: Result:= (not iOp1) and 1;

TRD_LT: if iOp1

else Result:= 0;

TRD_GT: if iOp1>iOp2 then Result:= 1

else Result:= 0;

TRD_EQ: if iOp1=iOp2 then Result:= 1

else Result:= 0;

TRD_NEQ: if iOp1<>iOp2 then Result:= 1

else Result:= 0;

TRD_ADD: Result:= iOp1 + iOp2;

TRD_SUB: Result:= iOp1 – iOp2;

TRD_UMIN: Result:= – iOp2;

end;

end;

end.

 

Модуль описания структур данных триад

Листинг П3.10. Описание структур данных триад

unit Triads;

interface

{ Модуль, обеспечивающий работу с триадами и их списком }

uses Classes, TblElem, LexElem, TrdType;

type

TTriad = class; { Предварительное описание класса триад }

TOpType = (OP_CONST, OP_VAR, OP_LINK); { Типы операндов:

константа, переменная, ссылка на другую триаду }

TOperand = record { Структура описания операнда в триадах }

case OpType: TOpType of { Тип операнда }

OP_CONST: (ConstVal: integer);{для констант – значение}

OP_VAR: (VarLink: TVarInfo);{ для переменной – ссылка

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

OP_LINK: (TriadNum: integer);{ для триады – номер }

end;

TOpArray = array[1..2] of TOperand; {Массив из 2 операндов}

TTriad = class(TObject)

private { Структура данных для описания триады }

TriadType: TTriadType; { Тип триады }

Operands: TOpArray; { Массив операндов }

public

Info: longint; { Дополнительная информация

для оптимизирующих алгоритмов }

IsLinked: Boolean; { Флаг наличия ссылки на эту триаду }

{ Конструктор для создания триады }

constructor Create(Typ: TTriadType; const Ops: TOpArray);

{ Функции для чтения и записи операндов }

function GetOperand(iIdx: integer): TOperand;

procedure SetOperand(iIdx: integer; Op: TOperand);

{ Функции для чтения и записи ссылок на другие триады }

function GetLink(iIdx: integer): integer;

procedure SetLink(iIdx: integer; TrdN: integer);

{ Функции для чтения и записи типа операндов }

function GetOpType(iIdx: integer): TOpType;

procedure SetOpType(iIdx: integer; OpT: TOpType);

{ Функции для чтения и записи значений констант }

function GetConstVal(iIdx: integer): integer;

procedure SetConstVal(iIdx: integer; iVal: integer);

{ Свойства триады, основанные на описанных функциях }

property TrdType: TTriadType read TriadType;

property Opers[iIdx: integer]: TOperand read GetOperand

write SetOperand; default;

property Links[iIdx: integer]: integer read GetLink

write SetLink;

property OpTypes[iIdx: integer]: TOpType read GetOpType

write SetOpType;

property Values[iIdx: integer]: integer read GetConstVal

write SetConstVal;

{ Функция, проверяющая эквивалентность двух триад }

function IsEqual(Trd1: TTriad): Boolean;

{ Функция, формирующая строковое представление триады }

function MakeString(i: integer): string;

end;

TTriadList = class(TList)

public { Класс для описания списка триад и работы с ним }

procedure Clear; override; { Процедура очистки списка }

destructor Destroy; override;{Деструктор удаления списка}

{ Процедура вывода списка триад в список строк

для отображения списка триад }

procedure WriteToList(list: TStrings);

{ Процедура удаления триады из списка }

procedure DelTriad(iIdx: integer);

{ Функция получения триады из списка по ее номеру }

function GetTriad(iIdx: integer): TTriad;

{ Свойство списка триад для доступа по номеру триады }

property Triads[iIdx: integer]: TTriad read GetTriad;

default;

end;

{ Процедура удаления из списка триад заданного типа }

procedure DelTriadTypes(listTriad: TTriadList;

TrdType: TTriadType);

implementation

uses SysUtils, FncTree, LexType;

constructor TTriad.Create(Typ: TTriadType;

const Ops: TOpArray);

{ Конструктор создания триады }

var i: integer;

begin

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

TriadType:= Typ; { Запоминаем тип триады }

{ Запоминаем два операнда триады }

for i:=1 to 2 do Operands[i]:= Ops[i];

Info:= 0; { Очищаем поле дополнительной информации }

IsLinked:= False; { Очищаем поле внешней ссылки }

end;

function TTriad.GetOperand(iIdx: integer): TOperand;

{ Функция получения данных об операнде по его номеру }

begin Result:= Operands[iIdx]; end;

procedure TTriad.SetOperand(iIdx: integer; Op: TOperand);

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

begin Operands[iIdx]:= Op; end;

function TTriad.GetLink(iIdx: integer): integer;

{ Функция получения ссылки на другую триаду из операнда }

begin Result:= Operands[iIdx].TriadNum; end;

procedure TTriad.SetLink(iIdx: integer; TrdN: integer);

{ Функция записи номера ссылки на другую триаду }

begin Operands[iIdx].TriadNum:= TrdN; end;

function TTriad.GetOpType(iIdx: integer): TOpType;

{ Функция получения типа операнда по его номеру }

begin Result:= Operands[iIdx].OpType; end;

function TTriad.GetConstVal(iIdx: integer): integer;

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

begin Result:= Operands[iIdx].ConstVal; end;

procedure TTriad.SetConstVal(iIdx: integer; iVal: integer);

{ Функция получения значения константы из операнда }

begin Operands[iIdx].ConstVal:= iVal; end;

procedure TTriad.SetOpType(iIdx: integer; OpT: TOpType);

{ Функция записи значения константы в операнд }

begin Operands[iIdx].OpType:= OpT; end;

function IsEqualOp(const Op1,Op2: TOperand): Boolean;

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

begin { Операнды равны, если совпадают их типы }

Result:= (Op1.OpType = Op2.OpType);

if Result then { и значения в зависимости от типа }

case Op1.OpType of

OP_CONST: Result:= (Op1.ConstVal = Op2.ConstVal);

OP_VAR: Result:= (Op1.VarLink = Op2.VarLink);

OP_LINK: Result:= (Op1.TriadNum = Op2.TriadNum);

end;

end;

function TTriad.IsEqual(Trd1: TTriad): Boolean;

{ Функция, проверяющая совпадение двух триад }

begin { Триады эквивалентны, если совпадают их типы }

Result:= (TriadType = Trd1.TriadType) { и оба операнда }

and IsEqualOp(Operands[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
,Trd1[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
)

and IsEqualOp(Operands[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
,Trd1[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
);

end;

function GetOperStr(Op: TOperand): string;

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

begin

case Op.OpType of

OP_CONST: Result:= IntToStr(Op.ConstVal);

OP_VAR: Result:= Op.VarLink.VarName;

OP_LINK: Result:= ^ + IntToStr(Op.TriadNum+1);

end{case};

end;

function TTriad.MakeString(i: integer): string;

begin

Result:= Format(%d: #9 %s (%s, %s),

[i+1,TriadStr[TriadType],

GetOperStr(Opers[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
), GetOperStr(Opers[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
)]);

end;

destructor TTriadList.Destroy;

{ Деструктор для удаления списка триад }

begin

Clear; { Очищаем список триад }

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

end;

procedure TTriadList.Clear;

{ Процедура очистки списка триад }

var i: integer;

begin { Освобождаем память для всех триад из списка }

for i:=Count-1 downto 0 do TTriad(Items[i]). Free;

inherited Clear; { Вызываем функцию базового класса }

end;

procedure TTriadList.DelTriad(iIdx: integer);

{ Функция удаления триады из списка триад }

begin

if iIdx < Count-1 then { Если это не последняя триада,

переставляем флаг ссылки на предыдущую (если флаг есть)}

TTriad(Items[iIdx+1]). IsLinked:=

TTriad(Items[iIdx+1]). IsLinked

or TTriad(Items[iIdx]). IsLinked;

TTriad(Items[iIdx]). Free; { Освобождаем память триады }

Delete(iIdx); { Удаляем ссылку на триаду из списка }

end;

function TTriadList.GetTriad(iIdx: integer): TTriad;

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

begin Result:= TTriad(Items[iIdx]); end;

procedure TTriadList.WriteToList(list: TStrings);

{ Процедура вывода списка триад в список строк

для отображения списка триад }

var i,iCnt: integer;

begin

list.Clear; { Очищаем список строк }

iCnt:= Count-1;

for i:=0 to iCnt do { Для всех триад из списка триад }

{ Формируем строковое представление триады

и добавляем его в список строк }

list.Add(TTriad(Items[i]). MakeString(i));

end;

procedure DelTriadTypes(listTriad: TTriadList;

TrdType: TTriadType);

{ Процедура удаления из списка триад заданного типа }

var

i,j,iCnt,iDel: integer;

listNum: TList;

Trd: TTriad; { Список запоминания изменений индексов }

begin

iDel:= 0; { В начале изменение индекса нулевое }

iCnt:= listTriad.Count-1;

{ Создаем список запоминания изменений индексов триад }

listNum:= TList.Create;

try

for i:=0 to iCnt do { Для всех триад списка выполняем }

begin { запоминание изменений индекса }

{ Запоминаем изменение индекса данной триады }

listNum.Add(TObject(iDel));

{Если триада удаляется, увеличиваем изменение индекса}

if listTriad[i].TriadType = TrdType then Inc(iDel);

end;

for i:=iCnt downto 0 do { Для всех триад списка }

begin { изменяем индексы ссылок }

Trd:= listTriad[i];

{ Если эта триада удаляемого типа, то удаляем ее }

if Trd.TriadType = TrdType then listTriad.DelTriad(i)

else { Иначе для каждого операнда триады смотрим,

не является ли он ссылкой }

for j:=1 to 2 do

if Trd[j].OpType = OP_LINK then { Если операнд

является ссылкой на триаду, уменьшаем ее индекс }

Trd.Links[j]:=

Trd.Links[j] – integer(listNum[Trd.Links[j]]);

end;

finally listNum.Free; { Уничтожаем временный список }

end;

end;

end.

 

Модуль, реализующий алгоритмы оптимизации списков триад

Листинг П3.11. Оптимизация списков триад

unit TrdOpt;

interface

{ Модуль, реализующий два алгоритма оптимизации:

– оптимизация путем свертки объектного кода;

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

uses Classes, TblElem, LexElem, TrdType, Triads;

type {Информационная структура для таблицы идентификаторов,

предназначенная для алгоритма свертки объектного кода}

TConstInfo = class(TAddVarInfo)

protected

iConst: longint; { Поле для записи значения переменной }

{ Конструктор для создания структуры }

constructor Create(iInfo: longint);

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

function GetInfo(iIdx: integer): longint; override;

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

override;

end;

{Информационная структура для таблицы идентификаторов,

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

TDepInfo = class(TAddVarInfo)

protected

iDep: longint; { Поле для записи числа зависимости }

{ Конструктор для создания структуры }

constructor Create(iInfo: longint);

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

function GetInfo(iIdx: integer): longint; override;

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

override;

end;

{ Процедура оптимизации методом свертки объектного кода }

procedure OptimizeConst(listTriad: TTriadList);

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

procedure OptimizeSame(listTriad: TTriadList);

implementation

uses SysUtils, FncTree, LexType, TrdCalc;

constructor TConstInfo.Create(iInfo: longint);

{ Создание структуры для свертки объектного кода }

begin

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

iConst:= iInfo; { Запоминаем информацию }

end;

procedure TConstInfo.SetInfo(iIdx: integer; iInf: longint);

{ Функция записи информации }

begin iConst:= iInfo; end;

function TConstInfo.GetInfo(iIdx: integer): longint;

{ Функция чтения инфоримации }

begin Result:= iConst; end;

function TestOperConst(Op: TOperand; listTriad: TTriadList;

var iConst: integer): Boolean;

{ Функция проверки того, что операнд является константой

и получения его значения в переменную iConst }

var pInfo: TConstInfo;

begin

Result:= False;

case Op.OpType of { Выборка по типу операнда }

OP_CONST: { Если оператор – константа, то все просто }

begin

iConst:= Op.ConstVal; Result:= True;

end;

OP_VAR: { Если оператор – переменная, }

begin { тогда проверяем наличие у нее

информационной структуры, }

pInfo:= TConstInfo(Op.VarLink.Info);

if pInfo <> nil then {и если такая структура есть,}

begin {берем ее значение}

iConst:= pInfo[0]; Result:= True;

end;

end;

OP_LINK: { Если оператор – ссылка на триаду, }

begin { то он является константой,

если триада имеет тип «CONST» }

if listTriad[Op.TriadNum].TrdType = TRD_CONST

then begin

iConst:= listTriad[Op.TriadNum][1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
.ConstVal;

Result:= True;

end;

end;

end{case};

end;

procedure OptimizeConst(listTriad: TTriadList);

{ Процедура оптимизации методом свертки объектного кода }

var

i,j,iCnt,iOp1,iOp2: integer;

Ops: TOpArray;

Trd: TTriad;

begin

{ Очищаем информационные структуры таблицы идентификаторов }

ClearTreeInfo; { Заполняем операнды триады типа «CONST» }

Ops[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
.OpType:= OP_CONST;

Ops[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
.OpType:= OP_CONST;

Ops[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
.ConstVal:= 0;

iCnt:= listTriad.Count-1;

for i:=0 to iCnt do { Для всех триад списка }

begin { выполняем алгоритм }

Trd:= listTriad[i];

if Trd.TrdType in TriadLineSet then

begin { Если любой операнд линейной триады ссылается

на триаду «CONST», берем и запоминаем ее значение }

for j:=1 to 2 do

if (Trd[j].OpType = OP_LINK)

and (listTriad[Trd.Links[j]].TrdType = TRD_CONST)

then begin

Trd.OpTypes[j]:= OP_CONST;

Trd.Values[j]:=

listTriad[Trd.Links[j]][1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
.ConstVal;

end;

end

else

if Trd.TrdType = TRD_IF then

begin { Если первый операнд условной триады ссылается

на триаду «CONST», берем и запоминаем ее значение }

if (Trd[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
.OpType = OP_LINK)

and (listTriad[Trd.Links[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
].TrdType = TRD_CONST)

then begin

Trd.OpTypes[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
:= OP_CONST;

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

listTriad[Trd.Links[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
][1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
.ConstVal;

end;

end

else

if Trd.TrdType = TRD_ASSIGN then

begin { Если второй операнд триады присвоения ссылается

на триаду «CONST», берем и запоминаем ее значение }

if (Trd[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
.OpType = OP_LINK)

and (listTriad[Trd.Links[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
].TrdType = TRD_CONST)

then begin

Trd.OpTypes[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
:= OP_CONST;

Trd.Values[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
:=

listTriad[Trd.Links[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
][1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
.ConstVal;

end;

end;{ Если триада помечена ссылкой, то линейный участок

кода закончен – очищаем информационные структуры идентификаторов}

if Trd.IsLinked then ClearTreeInfo;

if Trd.TrdType = TRD_ASSIGN then { Если триада имеет }

begin { тип «присвоение» }

{ и если ее второй операнд – константа, }

if TestOperConst(Trd[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
,listTriad,iOp2) then

{запоминаем его значение в информационной структуре переменной}

Trd[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
.VarLink.Info:= TConstInfo.Create(iOp2);

end

else { Если триада – одна из линейных операций, }

if Trd.TrdType in TriadLineSet then

begin { и если оба ее операнда – константы, }

if TestOperConst(Trd[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
,listTriad,iOp1)

and TestOperConst(Trd[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
,listTriad,iOp2) then

begin { тогда вычисляем значение операции, }

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

CalcTriad(Trd.TrdType,iOp1,iOp2);

{ запоминаем его в триаде «CONST», которую

записываем в список вместо прежней триады }

listTriad.Items[i]:= TTriad.Create(TRD_CONST,Ops);

{Если на прежнюю триаду была ссылка, сохраняем ее}

listTriad[i].IsLinked:= Trd.IsLinked;

Trd.Free; { Уничтожаем прежнюю триаду }

end;

end;

end;

end;

constructor TDepInfo.Create(iInfo: longint);

{ Создание информационной структуры для чисел зависимости }

begin

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

iDep:= iInfo; { Запоминаем число зависимости }

end;

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

{ Функция записи числа зависимости }

begin iDep:= iInfo; end;

function TDepInfo.GetInfo(iIdx: integer): longint;

{ Функция чтения числа зависимости }

begin Result:= iDep; end;

function CalcDepOp(listTriad: TTriadList;

Op: TOperand): longint;

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

begin

Result:= 0;

case Op.OpType of { Выборка по типу операнда }

OP_VAR: { Если это переменная – смотрим ее информационную

структуру, и если она есть, берем число зависимости }

if Op.VarLink.Info <> nil then Result:=

Op.VarLink.Info.Info[0];

OP_LINK: { Если это ссылка на триаду,

то берем число зависимости триады }

Result:= listTriad[Op.TriadNum].Info;

end{case};

end;

function CalcDep(listTriad: TTriadList;

Trd: TTriad): longint;

{ Функция вычисления числа зависимости триады }

var iDepTmp: longint;

begin

Result:= CalcDepOp(listTriad,Trd[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
);

iDepTmp:= CalcDepOp(listTriad,Trd[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
);

{ Число зависимости триады есть число на единицу большее,

чем максимальное из чисел зависимости ее операндов }

if iDepTmp > Result then Result:= iDepTmp+1

else Inc(Result);

Trd.Info:= Result;

end;

procedure OptimizeSame(listTriad: TTriadList);

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

var

i,j,iStart,iCnt,iNum: integer;

Ops: TOpArray;

Trd: TTriad;

begin { Начало линейного участка – начало списка триад }

iStart:= 0;

ClearTreeInfo; { Очищаем информационные структуры

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

Ops[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
.OpType:= OP_LINK; { Заполняем операнды }

Ops[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
.OpType:= OP_CONST; { для триады типа «SAME» }

Ops[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
.ConstVal:= 0;

iCnt:= listTriad.Count-1;

for i:=0 to iCnt do { Для всех триад списка }

begin { выполняем алгоритм }

Trd:= listTriad[i];

if Trd.IsLinked then {Если триада помечена ссылкой, }

begin { то линейный участок кода закончен – очищаем }

ClearTreeInfo; { информационные структуры идентификаторов и }

iStart:= i; { запоминаем начало линейного участка }

end;

for j:=1 to 2 do { Если любой операнд триады ссылается

if Trd[j].OpType = OP_LINK then { на триаду «SAME», }

begin { то переставляем ссылку на предыдущую, }

iNum:= Trd[j].TriadNum;{ совпадающую с ней триаду }

if listTriad[iNum].TrdType = TRD_SAME then

Trd.Links[j]:= listTriad[iNum].Links[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
;

end;

if Trd.TrdType = TRD_ASSIGN then { Если триада типа }

begin { «присвоение» – запоминаем число зависимости

связанной с нею переменной }

Trd[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
.VarLink.Info:= TDepInfo.Create(i+1);

end

else { Если триада – одна из линейных операций }

if Trd.TrdType in TriadLineSet then

begin { Вычисляем число зависимости триады }

CalcDep(listTriad,Trd);

for j:=iStart to i-1 do { На всем линейном участке }

begin { ищем совпадающую триаду с таким же }

if Trd.IsEqual(listTriad[j]) { числом зависимости }

and (Trd.Info = listTriad[j].Info) then

begin { Если триада найдена, запоминаем ссылку }

Ops[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
.TriadNum:= j;

{ запоминаем ее в триаде типа «SAME», которую

записываем в список вместо прежней триады }

listTriad.Items[i]:=

TTriad.Create(TRD_SAME,Ops);

listTriad[i].IsLinked:= Trd.IsLinked; { Если на

прежнюю триаду была ссылка, сохраняем ее }

Trd.Free; { Уничтожаем прежнюю триаду }

Break; { Прерываем поиск }

end;

end;

end{if};

end{for};

end;

end.

 

Модуль создания списка триад на основе дерева разбора

Листинг П3.12. Создание списка триад на основе дерева разбора

unit TrdMake; {!!! Зависит от входного языка!!!}

interface

{ Модуль, обеспечивающий создание списка триад на основе

структуры синтаксического разбора }

uses LexElem, Triads, SyntSymb;

function MakeTriadList(symbTop: TSymbol;

listTriad: TTriadList): TLexem;

{ Функция создания списка триад начиная от корневого

символа дерева синтаксического разбора.

Функция возвращает nil при успешном выполнении, иначе

она возвращает ссылку на лексему, где произошла ошибка }

implementation

uses LexType, TrdType;

function GetLexem(symbOp: TSymbol): TLexem;

{ Функция, проверяющая, является ли операнд лексемой }

begin

case symbOp.Rule of

0: Result:= symbOp.Lexem; {Нет правил – это лексема!}

27,28: Result:= symbOp[0].Lexem; { Если дочерний

символ построен по правилу № 27 или 28, то это лексема }

19,26: Result:= GetLexem(symbOp[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
) { Если это

арифметические скобки, надо проверить,

не является ли лексемой операнд в скобках }

else Result:= nil; { Иначе это не лексема }

end;

end;

function MakeTriadListNOP(symbTop: TSymbol;

listTriad: TTriadList): TLexem;

{ Функция создания списка триад начиная от корневого

символа дерева синтаксического разбора

(без добавления триады NOP в конец списка) }

var

Opers: TOpArray; { массив операндов триад }

iIns1,iIns2,iIns3: integer; { переменные для запоминания

индексов триад в списке }

function MakeOperand(

iOp{номер операнда},

iSymOp{порядковый номер символа в синтаксической конструкции},

iMin{минимальная позиция триады в списке},

iSymErr{номер лексемы, на который

позиционировать ошибку}: integer;

var iIns: integer{индекс триады в списке}): TLexem;

{ Функция формирования ссылки на операнд }

var lexTmp: TLexem;

begin

lexTmp:= GetLexem(symbTop[iSymOp]); { Проверяем, }

if lexTmp <> nil then { является ли операнд лексемой }

with lexTmp do { Если да, то берем имя операнда }

begin { в зависимости от типа лексемы }

if LexType = LEX_VAR then

begin

if VarInfo.VarName = NAME_RESULT then

begin{Убеждаемся, что переменная имеет допустимое имя}

Result:= lexTmp;

Exit;

end; { Если это переменная, то запоминаем ссылку

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

Opers[iOp].OpType:= OP_VAR;

Opers[iOp].VarLink:= VarInfo;

end

else

if LexType = LEX_CONST then

begin { Если это константа, то запоминаем ее значение }

Opers[iOp].OpType:= OP_CONST;

Opers[iOp].ConstVal:= ConstVal;

end

else begin { Иначе это ошибка, возвращаем лексему }

Result:= lexTmp; { как указатель на место ошибки }

Exit;

end;

iIns:= iMin; Result:= nil;

end

else { иначе это синтаксическая конструкция }

begin {Вызываем рекурсивно функцию создания списка триад}

Result:= MakeTriadListNOP(symbTop[iSymOp],listTriad);

if Result <> nil then Exit; {Ошибка – прерываем алгоритм}

iIns:= listTriad.Count; { Запоминаем индекс триады }

if iIns <= iMin then {Если индекс меньше минимального —}

begin { это ошибка }

Result:= symbTop[iSymErr].Lexem;

Exit;

end;

Opers[iOp].OpType:= OP_LINK;{Запоминаем ссылку на}

Opers[iOp].TriadNum:= iIns-1; {предыдущую триаду }

end;

end;

function MakeOperation(

Trd: TTriadType{тип создаваемой триады}): TLexem;

{ Функция создания списка триад для линейных операций }

begin { Создаем ссылку на первый операнд }

Result:= MakeOperand(1{op},0{sym},listTriad.Count,

1{sym err},iIns1);

if Result <> nil then Exit; {Ошибка – прерываем алгоритм}

{ Создаем ссылку на второй операнд }

Result:= MakeOperand(2{op},2{sym},iIns1,

1{sym err},iIns2);

if Result <> nil then Exit; {Ошибка – прерываем алгоритм}

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

listTriad.Add(TTriad.Create(Trd,Opers));

end;

begin { Тело главной функции }

case symbTop.Rule of { Начинаем с выбора типа правила }

5:{'if(B)EelseE'} { Полный условный оператор }

begin { Запоминаем ссылку на первый операнд

(условие «if(B)») }

Result:= MakeOperand(1{op},2{sym},listTriad.Count,

1{sym err},iIns1);

{ Если произошла ошибка, прерываем выполнение }

if Result <> nil then Exit;

Opers[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
.OpType:= OP_LINK; { Второй операнд – }

Opers[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
.TriadNum:= 0; {ссылка на триаду, номер

которой пока не известен}

{ Создаем триаду типа «IF» }

listTriad.Add(TTriad.Create(TRD_IF,Opers));

{ Запоминаем ссылку на второй операнд (раздел «(B)E») }

Result:= MakeOperand(2{op},4{sym},iIns1,

3{sym err},iIns2);

{ Если произошла ошибка, прерываем выполнение }

if Result <> nil then Exit;

Opers[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
.OpType:= OP_CONST; {Заполняем операнды}

Opers[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
.ConstVal:= 1; { для триады типа «JMP»,

которая должна быть в конце раздела «(B)E»}

Opers[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
.OpType:= OP_LINK; { Второй операнд – }

Opers[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
.TriadNum:= 0; {ссылка на триаду, номер

которой пока не известен}

{ Создаем триаду типа «JMP» }

listTriad.Add(TTriad.Create(TRD_JMP,Opers));

{ Для созданной ранее триады «IF» ставим ссылку

в конец последовательности триад раздела «(B)E» }

listTriad[iIns1].Links[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
:= iIns2+1;

{ Запоминаем ссылку на третий операнд (раздел «elseE») }

Result:= MakeOperand(2{op},6{sym},iIns2,

5{sym err},iIns3);

{ Если произошла ошибка, прерываем выполнение }

if Result <> nil then Exit;

{ Для созданной ранее триады «JMP» ставим ссылку

в конец последовательности триад раздела «elseE» }

listTriad[iIns2].Links[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
:= iIns3;

end;

6:{'if(B)E'} { Неполный условный оператор }

begin { Запоминаем ссылку на первый операнд

(условие «if(B)») }

Result:= MakeOperand(1{op},2{sym},listTriad.Count,

1{sym err},iIns1);

{ Если произошла ошибка, прерываем выполнение }

if Result <> nil then Exit;

Opers[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
.OpType:= OP_LINK; { Второй операнд – }

Opers[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
.TriadNum:= 0; {ссылка на триаду, номер

которой пока не известен}

{ Создаем триаду типа «IF» }

listTriad.Add(TTriad.Create(TRD_IF,Opers));

{ Запоминаем ссылку на второй операнд (раздел «(B)E») }

Result:= MakeOperand(2{op},4{sym},iIns1,

3{sym err},iIns2);

{ Если произошла ошибка, прерываем выполнение }

if Result <> nil then Exit;

{ Для созданной ранее триады «IF» ставим ссылку

в конец последовательности триад раздела «(B)E» }

listTriad[iIns1].Links[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
:= iIns2;

end;

8:{'while(B)doE'} { Оператор цикла «while» }

begin { Запоминаем ссылку на первый операнд

(условие «while(B)») }

iIns3:= listTriad.Count;

Result:= MakeOperand(1{op},2{sym},iIns3,

1{sym err},iIns1);

{ Если произошла ошибка, прерываем выполнение }

if Result <> nil then Exit;

Opers[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
.OpType:= OP_LINK; { Второй операнд – }

Opers[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
.TriadNum:= 0; {ссылка на триаду, номер

которой пока не известен}

{ Создаем триаду типа «IF» }

listTriad.Add(TTriad.Create(TRD_IF,Opers));

{ Запоминаем ссылку на второй операнд (раздел «doE») }

Result:= MakeOperand(2{op},5{sym},iIns1,

4{sym err},iIns2);

{ Если произошла ошибка, прерываем выполнение }

if Result <> nil then Exit;

Opers[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
.OpType:= OP_CONST; {Заполняем операнды}

Opers[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
.ConstVal:= 1; { для триады типа «JMP»,

которая должна быть в конце раздела «doE» }

{ Второй операнд – ссылка на начало списка триад }

Opers[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
.OpType:= OP_LINK;

Opers[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
.TriadNum:= iIns3;

{ Создаем триаду типа «JMP» }

listTriad.Add(TTriad.Create(TRD_JMP,Opers));

{ Для созданной ранее триады «IF» ставим ссылку

в конец последовательности триад раздела «doE» }

listTriad[iIns1].Links[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
:= iIns2+1;

end;

9:{'a:=E'} { Оператор присвоения }

begin { Если первый операнд не является переменной,

то это ошибка }

if symbTop[0].Lexem.LexType <> LEX_VAR then

begin

Result:= symbTop[0].Lexem; Exit;

end; { Если имя первого операнда совпадает с именем

параметра, то это семантическая ошибка }

if (symbTop[0].Lexem.VarName = NAME_INPVAR)

or (symbTop[0].Lexem.VarName = NAME_RESULT) then

begin

Result:= symbTop[0].Lexem; Exit;

end;

{ Создаем ссылку на первый операнд – переменную }

Opers[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
.OpType:= OP_VAR;

Opers[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
.VarLink:= symbTop[0].Lexem.VarInfo;

{ Создаем ссылку на второй операнд }

Result:= MakeOperand(2{op},2{sym},listTriad.Count,

1{sym err},iIns1);

{ Если произошла ошибка, прерываем выполнение }

if Result <> nil then Exit;

{ Создаем триаду типа «присваивание» }

listTriad.Add(TTriad.Create(TRD_ASSIGN,Opers));

end;

{ Генерация списка триад для линейных операций }

10:{'BorB'} Result:= MakeOperation(TRD_OR);

11:{'BxorB'} Result:= MakeOperation(TRD_XOR);

13:{'BandB'} Result:= MakeOperation(TRD_AND);

15:{'E

16:{'E>E'} Result:= MakeOperation(TRD_GT);

17:{'E=E'} Result:= MakeOperation(TRD_EQ);

18:{'E<>E'} Result:= MakeOperation(TRD_NEQ);

21:{'E-E'} Result:= MakeOperation(TRD_SUB);

22:{'E+E'} Result:= MakeOperation(TRD_ADD);

20:{not(B)}

begin { Создаем ссылку на первый операнд }

Result:= MakeOperand(1{op},2{sym},listTriad.Count,

1{sym err},iIns1);

{ Если произошла ошибка, прерываем выполнение }

if Result <> nil then Exit;

Opers[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
.OpType:= OP_CONST; {Второй операнд для}

Opers[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
.ConstVal:= 0; { NOT не имеет значения }

{ Создаем триаду типа «NOT» }

listTriad.Add(TTriad.Create(TRD_NOT,Opers));

end;

24:{uminE}

begin { Создаем ссылку на второй операнд }

Result:= MakeOperand(2{op},1{sym},listTriad.Count,

0{sym err},iIns1);

{ Если произошла ошибка, прерываем выполнение }

if Result <> nil then Exit;

Opers[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
.OpType:= OP_CONST; {Первый операнд для}

Opers[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
.ConstVal:= 0; { унарной операции "-"

должен быть 0 }

{ Создаем триаду типа «UMIN» }

listTriad.Add(TTriad.Create(TRD_UMIN,Opers));

end;

{ Для логических, арифметических или операторных скобок

рекурсивно вызываем функцию для второго символа }

1,7,19,26:{'progEend.,'beginEend', (E), (B) }

Result:= MakeTriadListNOP(symbTop[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
,listTriad);

3:{E;E Для списка операторов нужно рекурсивно вызвать}

begin { функцию два раза }

Result:= MakeTriadListNOP(symbTop[0],listTriad);

if Result <> nil then Exit;

Result:= MakeTriadListNOP(symbTop[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
,listTriad);

end;

27,28: Result:= nil; { Для лексем ничего не нужно }

{ Во всех остальных случаях нужно рекурсивно вызвать

функцию для первого символа }

else Result:= MakeTriadListNOP(symbTop[0],listTriad);

end{case Rule};

end;

function MakeTriadList(symbTop: TSymbol;

listTriad: TTriadList): TLexem;

{ Функция создания списка триад начиная от корневого

символа дерева синтаксического разбора }

var

i: integer;

Opers: TOpArray;

Trd: TTriad;

begin { Создаем список триад }

Result:= MakeTriadListNOP(symbTop,listTriad);

if Result = nil then {Если ошибка, прерываем выполнение}

with listTriad do

begin { Создаем пустую триаду «NOP» в конце списка }

Opers[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
.OpType:= OP_CONST;

Opers[1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
.ConstVal:= 0;

Opers[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
.OpType:= OP_CONST;

Opers[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
.ConstVal:= 0;

Add(TTriad.Create(TRD_NOP,Opers));

for i:=Count-1 downto 0 do

begin {Для всех триад в списке расставляем флаг ссылки}

Trd:= Triads[i];

if Trd.TrdType in [TRD_IF,TRD_JMP] then

begin { Если триада «переход» («IF» или «JMP»)

ссылается на другую триаду,}

if Trd.OpTypes[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
= OP_LINK then

listTriad[Trd.Links[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
].IsLinked:= True;

{ то ту триаду надо пометить }

end;

end;

end;

end;

end.

 

Модуль построения ассемблерного кода по списку триад

Листинг П3.13. Построение ассемблерного кода по списку триад

unit TrdAsm;

{!!! Зависит от целевой вычислительной системы!!! }

interface

{ Модуль распределения регистров и построения ассемблерного

кода по списку триад }

uses Classes, TrdType, Triads;

const { Префикс наименования временных переменных }

TEMP_VARNAME = _Tmp';

NUM_PROCREG = 6; { Количество доступных регистров }

{ Функция распределения регистров и временных переменных

для хранения промежуточных результатов триад }

function MakeRegisters(listTriad: TTriadList): integer;

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

function MakeAsmCode(listTriad: TTriadList;

listCode: TStrings;

flagOpt: Boolean): integer;

implementation

uses SysUtils;

function MakeRegisters(listTriad: TTriadList): integer;

{ Функция распределения регистров и временных переменных

для хранения промежуточных результатов триад.

Результат: количество необходимых временных переменных }

var

i,j,iR,iCnt,iNum: integer;{Счетчики и переменные циклов}

{ Динамический массив для запоминания занятых регистров }

listReg: TList;

begin { Создаем массив для хранения занятых регистров }

listReg:= TList.Create;

Result:= 0;

if listReg <> nil then

try { Обнуляем информационное поле у всех триад }

for i:=listTriad.Count-1 downto 0 do

listTriad[i].Info:= 0;

{ Цикл по всем триадам. Обязательно с конца списка! }

for i:=listTriad.Count-1 downto 0 do

for j:=1 to 2 do { Цикл по всем (2) операндам }

{ Если триада – линейная операция, или «IF»

(первый операнд), или присвоение (второй операнд) }

if ((listTriad[i].TrdType in TriadLineSet)

or (listTriad[i].TrdType = TRD_IF) and (j = 1)

or (listTriad[i].TrdType = TRD_ASSIGN) and (j = 2))

{ и операндом является ссылка на другую триаду }

and (listTriad[i][j].OpType = OP_LINK) then

begin { Запоминаем номер триады, на которую направлена ссылка }

iNum:= listTriad[i][j].TriadNum;

{ Если триаде еще не назначен регистр и если это

не предыдущая триада – надо ей назначить регистр }

if (listTriad[iNum].Info = 0) and (iNum <> i-1) then

begin { Количество назначенных регистров }

iCnt:= listReg.Count-1;

for iR:=0 to iCnt do

begin{ Цикл по массиву назначенных регистров }

{ Если область действия регистра за пределами

текущей триады, то его можно использовать }

if longint(listReg[iR]) >= i then

begin { Запоминаем область действия регистра }

listReg[iR]:= TObject(iNum);

{ Назначаем регистр триаде с номером iNum }

listTriad[iNum].Info:= iR+1;

Break; { Прерываем цикл по массиву регистров }

end;

end; { Если ни один из использованных регистров

не был назначен, надо брать новый регистр }

if listTriad[iNum].Info = 0 then

begin { Добавляем запись в массив регистров,

указываем ей область действия iNum }

listReg.Add(TObject(iNum));

{ Назначаем новый регистр триаде с номером iNum }

listTriad[iNum].Info:= listReg.Count;

end;

end;

end;{ Результат функции: количество записей в массиве

регистров -1, за вычетом числа доступных регистров}

Result:= listReg.Count – (NUM_PROCREG-1);

finally listReg.Free;

end;

end;

function GetRegName(iInfo: integer): string;

{ Функция наименования регистров процессора }

begin

case iInfo of

0: Result:= 'eax';

1: Result:= 'ebx';

2: Result:= 'ecx';

3: Result:= 'edx';

4: Result:= 'esi';

5: Result:= 'edi';

{ Если это не один из регистров – значит,

даем имя временной переменной }

else Result:=

Format(%s%d',[TEMP_VARNAME,iInfo-NUM_PROCREG]);

end{case};

end;

function GetOpName(i: integer; listTriad: TTriadList;

iOp: integer): string;

{ Функция наименования операнда триады

i – номер триады в списке;

listTriad – список триад;

iOp – номер операнда триады }

var iNum: integer; {номенр триады по ссылке}

Triad: TTriad; {текущая триада}

begin

Triad:= listTriad[i]; { Запоминаем текущую триаду }

{ Выборка наименования операнда в зависимости от типа }

case Triad[iOp].OpType of

{ Если константа – значение константы }

OP_CONST: Result:= IntToStr(Triad[iOp].ConstVal);

{ Если переменная – ее имя из таблицы идентификаторов }

OP_VAR:

begin

Result:= Triad[iOp].VarLink.VarName;

{ Если имя совпадает с именем функции,

заменяем его на Result функции }

if Result = NAME_FUNCT then Result:= NAME_RESULT;

end; { Иначе – это регистр }

else { для временного хранения результатов триады }

begin { Запоминаем номер триады }

iNum:= Triad[iOp].TriadNum;

{ Если это предыдущая триада, то операнд не нужен }

if iNum = i-1 then Result:=

else

begin {Берем номер регистра, связанного с триадой}

iNum:= listTriad[iNum].Info;

{ Если регистра нет, то операнд не нужен }

if iNum = 0 then Result:=

{ Иначе имя операнда – это имя регистра }

else Result:= GetRegName(iNum);

end;

end;

end{case};

end;

function MakeMove(const sReg,{имя регистра}

sPrev,{предыдущая команда}

sVal{предыдущая величина в eax}: string;

flagOpt: Boolean{флаг оптимизации}): string;

{ Функция, генерящая код занесения значения в регистр eax }

begin { Если операнд был только что выгружен из eax

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

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

if (Pos(Format(#9'mov'#9 %s,eax',[sReg]), sPrev) = 1)

or (sVal = sReg) then

begin

Result:= ; Exit;

end;

if flagOpt then { Если оптимизация команд включена }

begin

if sReg = 0 then { Если требуемое значение = 0, }

begin{его можно получить из –1 и 1 с помощью INC и DEC}

if sVal = -1 then Result:= #9'inc'#9'eax'

else

if sVal = 1 then Result:= #9'dec'#9'eax'

else Result:= #9'xor'#9'eax,eax'

end {иначе – с помощью XOR}

else

if sReg = 1 then { Если требуемое значение = 1, }

begin{его можно получить из –1 и 0 с помощью NEG и INC}

if sVal = -1 then Result:= #9'neg'#9'eax'

else

if sVal = 0 then Result:= #9'inc'#9'eax'

else

Result:= #9'xor'#9'eax,eax'#13#10#9'inc'#9'eax';

end {иначе – двумя командами: XOR и INC }

else

if sReg = -1 then { Если требуемое значение = -1, }

begin{его можно получить из 1 и 0 с помощью NEG и DEC}

if sVal = 1 then Result:= #9'neg'#9'eax'

else

if sVal = 0 then Result:= #9'dec'#9'eax'

else

Result:= #9'xor'#9'eax,eax'#13#10#9'dec'#9'eax';

end {иначе – двумя командами: XOR и DEC }

{ Иначе заполняем eax командой MOV }

else Result:= Format(#9'mov'#9'eax,%s',[sReg]);

end { Если оптимизация команд выключена,

всегда заполняем eax командой MOV }

else Result:= Format(#9'mov'#9'eax,%s',[sReg]);

end;

function MakeOpcode(i: integer;{номер текущей триады}

listTriad: TTriadList;{список триад}

const sOp,sReg,{код операции и операнд}

sPrev,{предыдущая команда}

sVal{предыдущая величина в eax}: string;

flagOpt: Boolean{флаг оптимизации}): string;

{ Функция, генерящая код линейных операций над eax }

var Triad: TTriad;{текущая триада}

begin { Запоминаем текущую триаду }

Triad:= listTriad[i];

if flagOpt then { Если оптимизация команд включена }

begin

if sReg = 0 then { Если операнд = 0 }

begin

case Triad.TrdType of

TRD_AND: { Для команды AND результат всегда = 0 }

Result:= MakeMove(0 ,sPrev,sVal,flagOpt);

{ Для OR, "+" и «-» ничего не надо делать }

TRD_OR,TRD_ADD,TRD_SUB: Result:= #9#9;

{ Иначе генерируем код выполняемой операции }

else Result:= Format(#9 %s'#9'eax,%s',[sOp,sReg]);

end{case};

end

else

if sReg = 1 then { Если операнд = 1 }

begin

case Triad.TrdType of

TRD_OR: { Для команды OR результат всегда = 1 }

Result:= MakeMove(1 ,sPrev,sVal,flagOpt);

{ Для AND ничего не надо делать }

TRD_AND: Result:= #9#9;

{ Для "+" генерируем операцию INC }

TRD_ADD: Result:= #9'inc'#9'eax';

{ Для «-» генерируем операцию DEC }

TRD_SUB: Result:= #9'dec'#9'eax';

{ Иначе генерируем код выполняемой операции }

else Result:= Format(#9 %s'#9'eax,%s',[sOp,sReg]);

end{case};

end

else

if sReg = -1 then { Если операнд = -1 }

begin

case Triad.TrdType of

{ Для "+" генерируем операцию DEC }

TRD_ADD: Result:= #9'dec'#9'eax';

{ Для «-» генерируем операцию INC }

TRD_SUB: Result:= #9'inc'#9'eax';

{ Иначе генерируем код выполняемой операции }

else Result:= Format(#9 %s'#9'eax,%s',[sOp,sReg]);

end{case};

end { Иначе генерируем код выполняемой операции }

else Result:= Format(#9 %s'#9'eax,%s',[sOp,sReg]);

end { Если оптимизация команд выключена,

всегда генерируем код выполняемой операции }

else Result:= Format(#9 %s'#9'eax,%s',[sOp,sReg]);

{ Добавляем к результату информацию о триаде

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

Result:= Result + Format(#9 { %s },

[Triad.MakeString(i)]);

end;

function MakeAsmCode(

listTriad: TTriadList;{входной список триад}

listCode: TStrings;{список строк результирующего кода}

flagOpt: Boolean{флаг оптимизации}): integer;

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

var i,iCnt: integer;{счетчик и переменная цикла}

sR: string;{строка для имени регистра}

sPrev,sVal: string;

{строки для хранения предыдущей команды и значения eax}

procedure TakePrevAsm;

{ Процедура, выделяющая предыдущую команду и значение eax

из списка результирующих команд }

var j: integer;

begin

j:= listCode.Count;

if j > 0 then

begin

sPrev:= listCode[j-1];

sVal:= StrPas(PChar(listCode.Objects[j-1]));

end

else

begin

sPrev:= ; sVal:= ;

end;

end;

procedure MakeOper1(const sOp,{код операции}

sAddOp: string;{код дополнительной операции}

iOp: integer{номер операнда в триаде});

{ Функция генерации кода для унарных операций }

var sReg{строка для имени регистра}: string;

begin

TakePrevAsm; {Берем предыдущую команду и значение из eax}

{ Запоминаем имя операнда }

sReg:= GetOpName(i,listTriad,iOp);

if sReg <> then { Если имя пустое, операнд уже есть в

регистре eax от выполнения предыдущей триады,}

begin { иначе его нужно занести в eax }

{ Вызываем функцию генерации кода занесения операнда }

sReg:= MakeMove(sReg,sPrev,sVal,flagOpt);

if sReg <> then listCode.Add(sReg);

end; { Генерируем непосредственно код операции }

listCode.Add(Format(#9 %s'#9'eax'#9 { %s },

[sOp,listTriad[i].MakeString(i)]));

if sAddOp <> then { Если есть дополнительная операция,

генерируем ее код }

listCode.Add(Format(#9 %s'#9'eax,1,[sAddOp]));

if listTriad[i].Info <> 0 then { Если триада связана с

begin { регистром, запоминаем результат в этом регистре }

sReg:= GetRegName(listTriad[i].Info);

{ При этом запоминаем, что сейчас находится в eax }

listCode.AddObject(Format(#9'mov'#9 %s,eax',[sReg]),

TObject(PChar(sReg)));

end;

end;

procedure MakeOper2(const sOp,{код операции}

sAddOp: string{код дополнительная операции});

{ Функция генерации кода для бинарных арифметических

и логических операций }

var sReg1,sReg2{строки для имен регистров}: string;

begin

TakePrevAsm; {Берем предыдущую команду и значение из eax}

{ Запоминаем имена первого и второго операндов }

sReg1:= GetOpName(i,listTriad,1);

sReg2:= GetOpName(i,listTriad,2);

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

есть в регистре eax от выполнения предыдущей триады -

вызываем функцию генерации кода для второго операнда }

if (sReg1 = ) or (sReg1 = sVal) then

listCode.Add(MakeOpCode(i,listTriad,sOp,sReg2,

sPrev,sVal,flagOpt))

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

есть в регистре eax от выполнения предыдущей триады -

вызываем функцию генерации кода для первого операнда }

if (sReg2 = ) or (sReg2 = sVal) then

begin

listCode.Add(MakeOpCode(i,listTriad,sOp,sReg1,

sPrev,sVal,flagOpt));

{ Если есть дополнительная операция, генерируем ее код

(когда операция несимметричная – например "-") }

if sAddOp <> then

listCode.Add(Format(#9 %s'#9'eax',[sAddOp]));

end

else { Если оба операнда не пустые, то надо:

– сначала загрузить в eax первый операнд;

– сгенерировать код для обработки второго операнда.}

begin

sReg1:= MakeMove(sReg1,sPrev,sVal,flagOpt);

if sReg1 <> then listCode.Add(sReg1);

listCode.Add(MakeOpCode(i,listTriad,sOp,sReg2,

sPrev,sVal,flagOpt));

end;

if listTriad[i].Info <> 0 then { Если триада связана с

begin { регистром, запоминаем результат в этом регистре }

sReg1:= GetRegName(listTriad[i].Info);

{ При этом запоминаем, что сейчас находится в eax }

listCode.AddObject(Format(#9'mov'#9 %s,eax',[sReg1]),

TObject(PChar(sReg1)));

end;

end;

procedure MakeCompare(const sOp: string

{флаг операции сравнения});

{ Функция генерации кода для операций сравнения }

var sReg1,sReg2{строки для имен регистров}: string;

begin

TakePrevAsm; {Берем предыдущую команду и значение из eax}

{ Запоминаем имена первого и второго операндов }

sReg1:= GetOpName(i,listTriad,1);

sReg2:= GetOpName(i,listTriad,2);

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

есть в регистре eax от выполнения предыдущей триады -

сравниваем eax со вторым операндом }

if sReg1 = then

listCode.Add(Format(#9'cmp'#9'eax,%s'#9 { %s },

[sReg2,listTriad[i].MakeString(i)]))

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

есть в регистре eax от выполнения предыдущей триады -

сравниваем eax с первым операндом в обратном порядке }

if sReg2 = then

listCode.Add(Format(#9'cmp'#9 %s,eax'#9 { %s },

[sReg1,listTriad[i].MakeString(i)]))

else { Если оба операнда не пустые, то надо:

– сначала загрузить в eax первый операнд;

– сравнить eax со вторым операндом. }

begin

sReg1:= MakeMove(sReg1,sPrev,sVal,flagOpt);

if sReg1 <> then listCode.Add(sReg1);

listCode.Add(Format(#9'cmp'#9'eax,%s'#9 { %s },

[sReg2,listTriad[i].MakeString(i)]));

end; { Загружаем в младший бит eax 1 или 0

в зависимости от флага сравнения }

listCode.Add(Format(#9'set%s'#9'al',[sOp]));

listCode.Add(#9'and'#9'eax,1); {очищаем остальные биты}

if listTriad[i].Info <> 0 then { Если триада связана с

begin { регистром, запоминаем результат в этом регистре }

sReg1:= GetRegName(listTriad[i].Info);

{ При этом запоминаем, что сейчас находится в eax }

listCode.AddObject(Format(#9'mov'#9 %s,eax',[sReg1]),

TObject(PChar(sReg1)));

end;

end;

begin { Тело главной функции }

iCnt:= listTriad.Count-1; { Количество триад в списке }

for i:=0 to iCnt do

begin { Цикл по всем триадам от начала списка }

{ Если триада помечена, создаем локальную метку

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

if listTriad[i].IsLinked then

listCode.Add(Format(@M%d:,[i+1]));

{ Генерация кода в зависимости от типа триады }

case listTriad[i].TrdType of

{ Код для триады IF }

TRD_IF: { Если операнд – константа, }

begin {(это возможно в результате оптимизации)}

if listTriad[i][1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
.OpType = OP_CONST then

begin { Условный переход превращается

в безусловный, если константа = 0,}

if listTriad[i][1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
.ConstVal = 0 then

listCode.Add(Format(#9'jmp'#9 @M%d'#9 { %s },

[listTriad[i][2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
.TriadNum+1,

listTriad[i].MakeString(i)]));

end { а иначе вообще генерировать код не нужно.}

else { Если операнд – не константа }

begin { Берем имя первого операнда }

sR:= GetOpName(i,listTriad,1);

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

значит он уже есть в регистре eax

от выполнения предыдущей триады, }

if sR = then

{ тогда надо выставить флаг «Z», сравнив eax

с ним самим, но учитывая, что предыдущая

триада для IF – это либо сравнение, либо

логическая операция, это можно опустить}

else { иначе надо сравнить eax с операндом }

listCode.Add(Format(#9'cmp'#9 %s,0,[sR]));

{Переход по условию «NOT Z» на ближайшую метку}

listCode.Add(Format(#9'jnz'#9 @F%d'#9 { %s },

[i,listTriad[i].MakeString(i)]));

{ Переход по прямому условию на дальнюю метку }

listCode.Add(Format(#9'jmp'#9 @M%d',

[listTriad[i][2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
.TriadNum+1]));

{ Метка для ближнего перехода }

listCode.Add(Format(@F%d:,[i]));

end;

end;

{ Код для бинарных логических операций }

TRD_OR: MakeOper2('or', );

TRD_XOR: MakeOper2('xor', );

TRD_AND: MakeOper2('and', );

{ Код для операции NOT (так как NOT(0)=FFFFFFFF,

то нужна еще операция: AND eax,1 }

TRD_NOT: MakeOper1('not','and',1);

{ Код для операций сравнения по их флагам }

TRD_LT: MakeCompare('l');

TRD_GT: MakeCompare('g');

TRD_EQ: MakeCompare('e');

TRD_NEQ: MakeCompare('ne');

{ Код для бинарных арифметических операций }

TRD_ADD: MakeOper2('add', );

TRD_SUB: MakeOper2('sub','neg');

{ Код для унарного минуса }

TRD_UMIN: MakeOper1('neg', ,2);

TRD_ASSIGN: { Код для операции присвоения }

begin {Берем предыдущую команду и значение из eax}

TakePrevAsm;

sR:= GetOpName(i,listTriad,2); {Имя второго операнда}

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

в регистре eax от выполнения предыдущей триады}

if sR <> then

begin {иначе генерируем код загрузки второго операнда}

sVal:= MakeMove(sR,sPrev,sVal,flagOpt);

if sVal <> then listCode.Add(sVal);

end; { Из eax записываем результат в переменную

с именем первого операнда }

sVal:= listTriad[i][1]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
.VarLink.VarName;

if sVal = NAME_FUNCT then sVal:= NAME_RESULT;

sVal:= Format(#9'mov'#9 %s,eax'#9 { %s },

[sVal,listTriad[i].MakeString(i)]);

{ При этом запоминаем, что было в eax }

listCode.AddObject(sVal,TObject(PChar(sR)));

end;

{ Код для операции безусловного перехода }

TRD_JMP: listCode.Add(

Format(#9'jmp'#9 @M%d'#9 { %s },

[listTriad[i][2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
.TriadNum+1,

listTriad[i].MakeString(i)]));

{ Код для операции NOP }

TRD_NOP: listCode.Add(Format(#9'nop'#9#9 { %s },

[listTriad[i].MakeString(i)]));

end{case};

end{for};

Result:= listCode.Count;

end;

end.

 

Модуль интерфейса с пользователем

Программный код

Листинг П3.14. Реализация пользовательского интерфейса

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;

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;{счетчик параметров и переменная цикла}

sT: string;{суммарная командная строка}

begin

sErrFile:= sErrF; { Запоминаем имя файла ошибок }

{ Записываем в файл ошибок дату запуска компилятора }

ErrInfo(sErrFile,

Format(– %s —,[DateTimeToStr(Now)]),0,0);

iCnt:= ParamCount; { Количество входных параметров }

sT:= ParamStr(0); { Обнуляем командную строку }

{Записываем в командную строку параметры последовательно}

for i:=1 to iCnt do sT:= sT + + ParamStr(i);

{ Записываем в файл ошибок суммарную командную строку }

ErrInfo(sErrFile,sT,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]Молчанов А. Ю. Системное программное обеспечение: Учебник для вузов. – СПб.: Питер, 2003. – 396 с.
<> – ) then

{ Запоминаем ошибку в список }

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

[i,sTmp]))

else { Иначе обрабатываем параметр в соответствии

с его типом (второй символ) }

case sTmp[2]Программные модули, реализующие таблицы символов, построены таким образом, что в зависимости от условий компиляции они могут либо различать, либо не различать прописные и строчные буквы. Условие компиляции реализовано через макрокоманды компилятора Delphi 5 в функции Upper в модуле TblElem (листинг П3.1, приложение 3). О принципах, на основе которых выполняются макрокоманды и условная компиляция, можно подробно узнать в [7, 13, 23, 25, 28, 32].
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,{флаг удаления триад типа "C"}

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

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.

Описание ресурсов пользовательского интерфейса

Описание ресурсов пользовательского интерфейса можно найти в архиве, расположенном на веб-сайте издательства, в файле FormLab4.dfm в подкаталоге CURSOV.

 

Пример 1. Вычисление факториала

Листинг П4.1. Входной файл

prog

if ((InpVar > 31) or InpVar<0) CompileTest:= 0

else

if (InpVar=0) CompileTest:= 1

else

begin

i:= InpVar;

Fact:= 1;

while (i<>-1) do

begin

j:= I-1;

Sum:= Fact;

while (not (j=0)) do

begin

Sum:= Sum + Fact;

j:= j-(-1);

end;

Fact:= Sum;

i:= i – 1;

end;

CompileTest:= Fact;

end;

end.

Листинг П4.2. Результирующий код

program MyCurs;

var

Fact,i,j,Sum: integer;

function CompileTest(InpVar: integer): integer; stdcall;

begin

asm

pushad {запоминаем регистры}

mov eax,InpVar

cmp eax,31 { 1: > (InpVar, 31) }

setg al

and eax,1

mov ebx,eax

mov eax,InpVar

cmp eax,0 { 2: < (InpVar, 0) }

setl al

and eax,1

or eax,ebx { 3: or (^1, ^2) }

jnz @F3 { 4: if (^3, ^7) }

jmp @M7

@F3:

xor eax,eax

mov Result,eax { 5::= (CompileTest, 0) }

jmp @M31 { 6: jmp (1, ^31) }

@M7:

mov eax,InpVar

cmp eax,0 { 7: = (InpVar, 0) }

sete al

and eax,1

jnz @F7 { 8: if (^7, ^11) }

jmp @M11

@F7:

xor eax,eax

inc eax

mov Result,eax { 9::= (CompileTest, 1) }

jmp @M31 { 10: jmp (1, ^31) }

@M11:

mov eax,InpVar

mov i,eax { 11::= (i, InpVar) }

xor eax,eax

inc eax

mov Fact,eax { 12::= (Fact, 1) }

@M13:

mov eax,i

cmp eax,1 { 13: <> (i, 1) }

setne al

and eax,1

jnz @F13 { 14: if (^13, ^30) }

jmp @M30

@F13:

mov eax,i

dec eax { 15: – (i, 1) }

mov j,eax { 16::= (j, ^15) }

mov eax,Fact

mov Sum,eax { 17::= (Sum, Fact) }

@M18:

mov eax,j

cmp eax,0 { 18: = (j, 0) }

sete al

and eax,1

not eax { 19: not (^18, 0) }

and eax,1

jnz @F19 { 20: if (^19, ^26) }

jmp @M26

@F19:

mov eax,Sum

add eax,Fact { 21: + (Sum, Fact) }

mov Sum,eax { 22::= (Sum, ^21) }

mov eax,j

dec eax { 23: – (j, 1) }

mov j,eax { 24::= (j, ^23) }

jmp @M18 { 25: jmp (1, ^18) }

@M26:

mov eax,Sum

mov Fact,eax { 26::= (Fact, Sum) }

mov eax,i

dec eax { 27: – (i, 1) }

mov i,eax { 28::= (i, ^27) }

jmp @M13 { 29: jmp (1, ^13) }

@M30:

mov eax,Fact

mov Result,eax { 30::= (CompileTest, Fact) }

@M31:

nop { 31: nop (0, 0) }

popad {восстанавливаем регистры}

end;

end;

var InpVar: integer;

begin

readln(InpVar);

writeln(CompileTest(InpVar));

readln;

end.

 

Пример 2. Иллюстрация работы функций оптимизации

Листинг П4.3. Входной файл

prog

D:= 0;

B:= 1;

C:= 1;

A:= C + InpVar;

D:= C+B+234;

C:= A + B + C;

D:= ((C) +(A+B)) – (InpVar + 1) + (A+B);

E:= (D – 22) – (A + B);

CompileTest:= 0;

if (a

and (be or not(b=0)))))))

a:=0 else a:=1;

if (InpVar > 0 or -1 <> InpVar)

while (a<1) do a:=a+(b+1)

else CompileTest:= InpVar+1;

end.

Листинг П4.4. Результирующий код без учета оптимизации

program MyCurs;

var

A,B,C,D,E: integer;

function CompileTest(InpVar: integer): integer; stdcall;

var

_Tmp0,_Tmp1: integer;

begin

asm

pushad {запоминаем регистры}

mov eax,0

mov D,eax { 1::= (D, 0) }

mov eax,1

mov B,eax { 2::= (B, 1) }

mov C,eax { 3::= (C, 1) }

add eax,InpVar { 4: + (C, InpVar) }

mov A,eax { 5::= (A, ^4) }

mov eax,C

add eax,B { 6: + (C, B) }

add eax,234 { 7: + (^6, 234) }

mov D,eax { 8::= (D, ^7) }

mov eax,A

add eax,B { 9: + (A, B) }

add eax,C { 10: + (^9, C) }

mov C,eax { 11::= (C, ^10) }

mov eax,A

add eax,B { 12: + (A, B) }

add eax,C { 13: + (C, ^12) }

mov ebx,eax

mov eax,InpVar

add eax,1 { 14: + (InpVar, 1) }

sub eax,ebx { 15: – (^13, ^14) }

neg eax

mov ebx,eax

mov eax,A

add eax,B { 16: + (A, B) }

add eax,ebx { 17: + (^15, ^16) }

mov D,eax { 18::= (D, ^17) }

sub eax,22 { 19: – (D, 22) }

mov ebx,eax

mov eax,A

add eax,B { 20: + (A, B) }

sub eax,ebx { 21: – (^19, ^20) }

neg eax

mov E,eax { 22::= (E, ^21) }

mov eax,0

mov Result,eax { 23::= (CompileTest, 0) }

mov eax,A

cmp eax,B { 24: < (A, B) }

setl al

and eax,1

mov ebx,eax

mov eax,A

cmp eax,C { 25: < (A, C) }

setl al

and eax,1

or eax,ebx { 26: or (^24, ^25) }

mov ebx,eax

mov eax,E

cmp eax,0 { 27: = (E, 0) }

sete al

and eax,1

mov ecx,eax

mov eax,D

cmp eax,0 { 28: = (D, 0) }

sete al

and eax,1

mov edx,eax

mov eax,B

cmp eax,C { 29: < (B, C) }

setl al

and eax,1

mov esi,eax

mov eax,A

cmp eax,C { 30: < (A, C) }

setl al

and eax,1

mov edi,eax

mov eax,C

cmp eax,E { 31: <> (C, E) }

setne al

and eax,1

mov _Tmp0,eax

mov eax,B

cmp eax,0 { 32: = (B, 0) }

sete al

and eax,1

not eax { 33: not (^32, 0) }

and eax,1

or eax,_Tmp0 { 34: or (^31, ^33) }

and eax,edi { 35: and (^30, ^34) }

or eax,esi { 36: or (^29, ^35) }

and eax,edx { 37: and (^28, ^36) }

xor eax,ecx { 38: xor (^27, ^37) }

xor eax,ebx { 39: xor (^26, ^38) }

jnz @F39 { 40: if (^39, ^43) }

jmp @M43

@F39:

mov eax,0

mov A,eax { 41::= (A, 0) }

jmp @M44 { 42: jmp (1, ^44) }

@M43:

mov eax,1

mov A,eax { 43::= (A, 1) }

@M44:

mov eax,InpVar

cmp eax,0 { 44: > (InpVar, 0) }

setg al

and eax,1

mov ebx,eax

mov eax,1

neg eax { 45: – (0, 1) }

cmp eax,InpVar { 46: <> (^45, InpVar) }

setne al

and eax,1

or eax,ebx { 47: or (^44, ^46) }

jnz @F47 { 48: if (^47, ^56) }

jmp @M56

@F47:

@M49:

mov eax,A

cmp eax,1 { 49: < (A, 1) }

setl al

and eax,1

jnz @F49 { 50: if (^49, ^55) }

jmp @M55

@F49:

mov eax,B

add eax,1 { 51: + (B, 1) }

add eax,A { 52: + (A, ^51) }

mov A,eax { 53::= (A, ^52) }

jmp @M49 { 54: jmp (1, ^49) }

@M55:

jmp @M58 { 55: jmp (1, ^58) }

@M56:

mov eax,InpVar

add eax,1 { 56: + (InpVar, 1) }

mov Result,eax { 57::= (CompileTest, ^56) }

@M58:

nop { 58: nop (0, 0) }

popad {восстанавливаем регистры}

end;

end;

var InpVar: integer;

begin

readln(InpVar);

writeln(CompileTest(InpVar));

readln;

end.

Листинг П4.5. Результирующий код с учетом оптимизации

program MyCurs;

var

A,B,C,D,E: integer;

function CompileTest(InpVar: integer): integer; stdcall;

begin

asm

pushad {запоминаем регистры}

xor eax,eax

mov D,eax { 1::= (D, 0) }

inc eax

mov B,eax { 2::= (B, 1) }

mov C,eax { 3::= (C, 1) }

add eax,InpVar { 4: + (C, InpVar) }

mov A,eax { 5::= (A, ^4) }

mov eax,236

mov D,eax { 6::= (D, 236) }

mov eax,A

add eax,B { 7: + (A, B) }

mov ebx,eax

add eax,C { 8: + (^7, C) }

mov C,eax { 9::= (C, ^8) }

add eax,ebx { 10: + (C, ^7) }

mov ecx,eax

mov eax,InpVar

inc eax { 11: + (InpVar, 1) }

sub eax,ecx { 12: – (^10, ^11) }

neg eax

add eax,ebx { 13: + (^12, ^7) }

mov D,eax { 14::= (D, ^13) }

mov eax,214

sub eax,ebx { 15: – (214, ^7) }

mov E,eax { 16::= (E, ^15) }

xor eax,eax

mov Result,eax { 17::= (CompileTest, 0) }

mov eax,A

cmp eax,B { 18: < (A, B) }

setl al

and eax,1

mov ebx,eax

mov eax,A

cmp eax,C { 19: < (A, C) }

setl al

and eax,1

mov edx,eax

or eax,ebx { 20: or (^18, ^19) }

mov ebx,eax

mov eax,E

cmp eax,0 { 21: = (E, 0) }

sete al

and eax,1

mov ecx,eax

mov eax,C

cmp eax,E { 22: <> (C, E) }

setne al

and eax,1

xor eax,eax

inc eax { 23: or (^22, 1) }

and eax,edx { 24: and (^19, ^23) }

{ 25: or (0, ^24) }

xor eax,eax { 26: and (0, ^25) }

xor eax,ecx { 27: xor (^21, ^26) }

xor eax,ebx { 28: xor (^20, ^27) }

jnz @F28 { 29: if (^28, ^32) }

jmp @M32

@F28:

xor eax,eax

mov A,eax { 30::= (A, 0) }

jmp @M33 { 31: jmp (1, ^33) }

@M32:

xor eax,eax

inc eax

mov A,eax { 32::= (A, 1) }

@M33:

mov eax,InpVar

cmp eax,0 { 33: > (InpVar, 0) }

setg al

and eax,1

mov ebx,eax

xor eax,eax

dec eax

cmp eax,InpVar { 34: <> (-1, InpVar) }

setne al

and eax,1

or eax,ebx { 35: or (^33, ^34) }

jnz @F35 { 36: if (^35, ^44) }

jmp @M44

@F35:

@M37:

mov eax,A

cmp eax,1 { 37: < (A, 1) }

setl al

and eax,1

jnz @F37 { 38: if (^37, ^43) }

jmp @M43

@F37:

mov eax,B

inc eax { 39: + (B, 1) }

add eax,A { 40: + (A, ^39) }

mov A,eax { 41::= (A, ^40) }

jmp @M37 { 42: jmp (1, ^37) }

@M43:

jmp @M46 { 43: jmp (1, ^46) }

@M44:

mov eax,InpVar

inc eax { 44: + (InpVar, 1) }

mov Result,eax { 45::= (CompileTest, ^44) }

@M46:

nop { 46: nop (0, 0) }

popad {восстанавливаем регистры}

end;

end;

var InpVar: integer;

begin

readln(InpVar);

writeln(CompileTest(InpVar));

readln;

end.