Разработка программы-компилятора
begin
if (Code_Tab [i]. Lex='end') and (Code_Tab [i+1]. Lex<>'; ') then
begin
Lex_body: =true;
i: =i+1;
end else Err_Synt ('Ожидается служебное слово end после блока операторов', i-1)
end;
end;
end;
3.5 Результаты тестирования синтаксического анализатора
Тестирование выполнялось на результатах работы лексического анализатора, который работает безошибочно и был протестирован ранее.
| Ошибка | Текст программы | Сообщения от анализатора |
| В объявлении имени программы |
prom var15; . . program var15. |
Отсутствует служебное слово program или в нём ошибка |
| В описании |
program var15; n: integer; . . program var15; var,: integer; . . program var15; var n: integer . . var n integer . . var n:; |
Отсутствует служебное слово var после заголовка программы Отсутствует идентификатор в описании Отсутствует точка с запятой после описания переменных Отсутствует двоеточие перед типом integer Отсутствует тип: integer |
| В begin. end |
. . begin; . . var n: integer; n: =$+00; . . until n<$-0A; |
После begin недопустим символ точка с запятой Отсутствует служебное слово begin после описания переменных Отсутствует служебное слово end в конце программы |
| В имени программы |
... program $+00;. |
Неправильное имя программы. Ошибочное выражение: "$+00" |
| В операторе присваивания |
... n: $+00; |
Ошибка в операторе присваивания |
| В выражении |
... n: =- (-XII);... |
Ожидается константа, идентификатор или выражение |
| В цикле |
... repeat n: =n- (-XII); n<$-0A;. |
Ожидается служебное слово until |
| В теле программы |
... n: =$+00. |
Ожидается точка с запятой после оператора (после лексемы $+00) |
4. Реализация двухфазного компилятора
Главные процедуры лексического и синтаксического анализатора - это, соответственно, процедуры N5. Click и N6. Click главной формы программы. Из них вызываются остальные подпрограммы
Текст исходная программа выводится в окне в верхнем левом углу формы. Если лексический анализ текста (процедура N5. Click) выявил ошибку, то она выводится в окне сообщёний об ошибках и анализ прекращается.
Лексический анализатор выводит на форму таблицы констант, идентификаторов, терминальных символов и кодов лексем в областях вывода StringGrid1, StringGrid2, StringGrid3 и StringGrid4.
После синтаксического анализа переданной таблицы кодов лексем в окне сообщений об ошибках синтаксического анализатора содержатся сообщения от распознающих процедур разного уровня, затронутых обнаруженной ошибкой (см п.3.5)
Ошибок при двухфазном анализе не выявлено, если область вывода лексических ошибок пуста, а для синтаксических - содержит текст "Ошибок нет".
Внешний вид окна программы представлен на рис.7.
4.1 Результаты тестирования двухфазного компилятора
полностью совпадают с результатами тестирования лексического и синтаксического анализатора по отдельности, проведённых последовательно.
рис.7. Внешний вид окна программы
5. Описание программы
5.1 Общие сведения и функциональное назначение
Данная программа предназначена для лексического и синтаксического анализа небольших (<1 МБ) текстов программ на заданном диалекте подмножества языка Pascal.
Программа написана на языке Delphi в среде разработки Delphi 7.
Программа предназначена для выявления наличия лексических и синтаксических ошибок во входном тексте программы.
5.2 Вызов и загрузка
Запуск файла lex1. exe.
5.3 Входные данные
Исходный текст программы, в текстовом файле ‘вар14. txt’ или в окне ввода исходного текста.
5.4 Выходные данные
Сообщение о первой ошибке, выявленной лексическим анализом, а при отсутствии таковых - вывод сообщения о первой обнаруженной синтаксической ошибке, при отсутствии ошибок - соответствующее сообщение.
5.5 Описание логической структуры программы
5.5.1 Файлы программы
Программа состоит из файлов:
lex. pas
lex. ~dfm
5.5.2 Общее описание работы программы
Основная форма программы - в файле lex. dfm, алгоритм её работы - в файле lex. pas.
Список строк исходного текста программы загружается в массив SA. Процедура Select_lex выполняет выделение из текста лексем. Таблицы констант, идентификаторов, терминальных символов и кодов лексем хранятся в массивах Const_Tab, Id_Tab, Term_Tab и Code_Tab. Распознавателем идентификаторов является функция Ident, 16-ричных констант - функция Const16, логических констант - функция Boolconst. Распознавателем терминальных символов является функция Termin. Если лексема ошибочна, то она заносится в таблицу кодов лексем с типом E и выдаётся сообщение об ошибке (процедура Err_Lex). Все эти подпрограммы вызываются из процедуры TForm1. N5Click (соответствует выбору пункта меню Анализатор/Лексический). В ней производится обнуление всех таблиц, вызов функции выделения лексем и процедуры WriteLex (см. ниже).
Поиск идентификаторов, констант и терминальных символов в соответствующих таблицах производится, соответственно, процедурами Search_Ident, Search_Const и Search_Term, добавление в таблицы - процедурами Add_Ident, Add_Const и Add_Term. Все они вызываются из процедуры WriteLex, входными данными для которой являются результаты распознавания лексем, т.е. типы лексем. Запись в таблицу кодов лексем производится процедурой WriteCode, вывод всех таблиц на экран - процедурой vyvod.
Перевод констант в десятичную форму производится процедурой perevod.
Процедура начала синтаксического анализа N6. Click вызывает процедуру Syntax, которая, в свою очередь, вызывает процедуру Lex_Progr, далее реализуется синтаксический анализ методом рекурсивного спуска.
Текст программы лексическому анализатору передаётся из поля в верхнем правом углу главного окна при выборе пункта меню "Анализ/Лексический", куда он может вводиться с клавиатуры или загружать из файла "вар14. txt" (он обязательно должен находиться в каталоге с программой) при создании формы. Полученный список лексем передаётся синтаксическому анализатору, а найденные им ошибки - в поле в левой части окна.
Список использованной литературы
Методические указания к лабораторным работам по СПО.
Курс лекций по дисциплине "Системное программное обеспечение".
А.Ю. Молчанов "Системное программное обеспечение", СПб, 2003 г.
Ю.Г. Карпов "Теория автоматов", СПб, 2002 г.
В.В. Фаронов“Delphi. Программирование на языке высокого уровня", Питер, 2004 г.
Приложение: текст программы
unit lex;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls, Grids;
type
TVyh = Record // Тип таблицы кодов лексем
nomer: integer; // Номер
typ: char; // Тип лексемы
Num: integer; // Номер в таблице
Lex: String; // Лексема
numstr: integer; // Номер строки
end;
TTerm = Record // тип таблицы терминальных символов
nomer: integer; // номер
Lex: String; // Лексема
razd: byte; // Разделитель?
oper: byte; // Операция?
slug: byte; // Служебное слово?
Left: integer; // Левая ветвь дерева.
Right: integer; // Правая ветвь дерева.
Way: string;
end;
TConst = Record // Тип таблицы констант
nomer: integer; // Номер
value: string; // Само значение лексемы.
Typ: string; // Тип лексемы
Width: string; // Ширина константы
Val10: string; // 10-тичный формат константы
Left: integer; // Левая ветвь дерева.
Right: integer; // Правая ветвь дерева.
Way: string;
end;
TId = Record // таблица имен
nomer: integer; // номер лексемы
lex: string; // лексема
ssylka: integer; // ссылка на элемент цепочки
end;
TForm1 = class (TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
OpenDialog1: TOpenDialog;
Memo1: TMemo;
N6: TMenuItem;
StringGrid1: TStringGrid;
Label1: TLabel;
StringGrid2: TStringGrid;
Label2: TLabel;
StringGrid3: TStringGrid;
StringGrid4: TStringGrid;
Label3: TLabel;
Label4: TLabel;
Memo2: TMemo;
Label5: TLabel;
procedure N2Click (Sender: TObject);
procedure N3Click (Sender: TObject);
procedure N5Click (Sender: TObject);
procedure vyvod;
procedure Err_lex;
procedure Syntax;
procedure Err_Synt (text: string; l: integer);
function Lex_Progr: boolean;
function Lex_Prog_Name: boolean;
function Lex_Descr_List: boolean;
function Lex_descr: boolean;
function Lex_name_list: boolean;
function Lex_type: boolean;
function Lex_oper_list: boolean;
function Lex_oper: boolean;
function Lex_assign: boolean;
function Lex_Exp: boolean;
function Lex_simple_Exp: boolean;
function Lex_Term: boolean;
function Lex_mnozh: boolean;
function Lex_repeat_until: boolean;
function Lex_body: boolean;
procedure N6Click (Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const
MaxNum=100; // Максимальное число лексем
deleter= ['. ',' ',' (',') ','{','}',',','<','>','"','? ','! ','*','&','^', {'%','$',}' [','] ',': ','; ','=','-','+','/', '',''''] ; // разделители лексем
words: Array [1. .14] of string [7] = ('program','var','then','begin','for','to','do','if','end','repeat','until','real','integer', 'else'); // Массив служебных слов
razdel: Array [1. .8] of char= (',','; ',': ',' (',') ',' [','] ','. '); // массив разделителей
operacii: Array [1. .11] of string [2] = (': =','>=','<=','<>','+','-','/','*','>','<','='); // массив операций
cifra= ['0'. '9'] ; // цифры
bukva= ['A'. 'F'] ;
var
Form1: TForm1;
FA,FName: textfile;
SA: array [1. .100] of string;
SS,Name,Constant: string;
Dlina: integer;
Code_tab: array [1. MaxNum] of TVyh; // Таблица кодов лексем
Term_tab: array [1. MaxNum] of TTerm; // Таблица терминальныз символов
Id_tab: array [1. MaxNum] of TId; // Таблица идентификаторов
Const_tab: array [1. .50] of TConst; // Таблица констант
Lexem,s,typel: string; // Лексема, Текст ошибки, Строка программы, Тип лексемы
i,j,k,l,m,n,y,String_counter,constyes,termyes,hesh, // счетчики циклов и строк
NumLex,{Число лексем}NumId,{Число идентификаторов}NumTerm,{Число терминальных символов}NumConst,{Число различных констант}
NumErr{Число ошибочных лексем}: integer;
Error,Found,Flag,Scobka: boolean; // Флаги
str16: string;
k1,kod: integer;
implementation
uses lex2;
{$R *. dfm}
procedure TForm1. N2Click (Sender: TObject);
var i: integer;
begin
OpenDialog1. Filter: ='*. txt';
if opendialog1. Execute and fileExists (openDialog1. FileName)
then
begin
Assignfile (FA, OpenDialog1. FileName);
Reset (FA);
Memo1. Lines. clear;
i: =1;
while not EOF (FA) do
begin
readln (Fa,SA [i]);
Memo1. Lines. Add (SA [i]);
i: =i+1;
end;
Closefile (FA);
end;
end;
// процедура перевода констант в десятичную форму
procedure perevod (SS: string; var Str16: string);
var ch3,ch4,ch, i: integer;
zn: string;
begin
ch: =0; // для римских констант
if (SS [2] ='X') or (SS [2] ='V') or (SS [2] ='I') then
begin
zn: =SS [1] ;
delete (SS,1,1);
while Length (SS) <>0 do
begin
if SS [1] ='X' then begin ch: =ch+10; delete (SS,1,1); end
else begin
if SS [1] ='V'then begin ch: =ch+5; delete (SS,1,1); end
else begin
if ( (SS [1] ='I') and (SS [2] ='I')) or ( (SS [1] ='I') and (SS [2] ='')) then begin ch: =ch+1; delete (SS,1,1); end
else begin
if (SS [1] ='I') and (SS [2] ='X') then begin ch: =ch+9; delete (SS,1,2); end
else begin
if (SS [1] ='I') and (SS [2] ='V') then begin ch: =ch+4; delete (SS,1,2); end;
end; end; end; end; end;
str16: =zn+IntToStr (ch);
exit;
end;
// для 16-рич. констант
If SS [3] in ['0'. '9']
then
ch3: =StrToInt (SS [3]) *16
else
if SS [3] in ['A'. 'F']
then
begin
ch3: =ord (SS [3]);
case ch3 of
65: ch3: =10*16;
66: ch3: =11*16;
67: ch3: =12*16;
68: ch3: =13*16;
69: ch3: =14*16;
70: ch3: =15*16;
end;
end;
If SS [4] in ['0'. '9']
then
ch4: =StrToInt (SS [4])
else
if SS [4] in ['A'. 'F']
then
begin
ch4: =ord (SS [4]);
case ch4 of
65: ch4: =10;
66: ch4: =11;
67: ch4: =12;
68: ch4: =13;
69: ch4: =14;
70: ch4: =15;
end;
end;
ch: =ch3+ch4;
If (SS [3] ='0') and (SS [4] ='0')
then Str16: =IntToStr (ch)
else Str16: =SS [2] +IntToStr (ch);
end;
procedure TForm1. N3Click (Sender: TObject);
begin
close;
end;
function Select_Lex (S: string; {исх. строка} var Rez: string; {лексема}N: integer {текущая позиция}): integer;
label 1;
begin // функция выбора слов из строки
k: = Length (S);
Rez: ='';
i: =N; // точка продолжения в строке
while (S [i] =' ') and (i<= k) do i: =i+1; // пропуск ' '
while not (S [i] in deleter) and (i<= k) do // накопление лексемы
begin
if s [i] ='$' then
begin
Rez: =s [i] +s [i+1] ;
i: =i+2;
end
else begin
1: Rez: =Rez+s [i] ;
i: =i+1;
end;
end;
if Rez='' then
begin
if (s [i] =': ') then
begin
if (s [i+1] ='=') then // в случае операции из двух символов
begin
Rez: =s [i] +s [i+1] ;
Select_Lex: =i+2;
end
else
begin
Rez: =s [i] ;
Select_Lex: =i+1;
end;
end else
begin
if ( (s [i] ='+') or (s [i] ='-')) and (s [i-1] =' (')
then begin
Rez: =s [i] +s [i+1] ;
i: =i+2;
goto 1;
end
else begin
Rez: =s [i] ;
Select_Lex: =i+1;
end; end;
end else Select_Lex: =i;
end;
procedure Add_Const (Curr_term: integer; str_lex: string); // Процедура добавления идентификаторов в дерево
begin
if NumConst=1 then // Если корень дерева еще не создан, то создаем его.
begin
perevod (str_lex,str16);
Const_tab [NumConst]. value: =str_lex;
Const_tab [NumConst]. nomer: =NumConst;
Const_tab [NumConst]. Val10: =str16;
Const_tab [NumConst]. Left: =0;
Const_tab [NumConst]. Right: =0;
Const_tab [NumConst]. Way: ='V';
Exit;
end;
if (CompareStr (Const_tab [Curr_term]. value,str_lex) >0) then // Если значение текущего узла дерева больше добавляемого
if Const_tab [Curr_term]. Left=0 then // если у этого элемента дерева нет левого указателя, то
begin
perevod (str_lex,str16);
Const_tab [Curr_term]. Left: =NumConst; // Создание левого элемента.
Const_tab [NumConst]. value: =str_lex;
Const_tab [NumConst]. nomer: =NumConst;
Const_tab [NumConst]. Val10: =str16;
Const_tab [NumConst]. Left: =0;
Const_tab [NumConst]. Right: =0;
Const_tab [NumConst]. Way: =Const_tab [NumConst]. Way+'L';
end else begin
Const_tab [NumConst]. Way: =Const_tab [NumConst]. Way+'L';
Add_Const (Const_tab [Curr_term]. Left,str_lex); // Если левый указатель существует, то вызываем уже функцию для левого указателя.
end;
if (CompareStr (Const_tab [Curr_term]. value,str_lex) <0) then // если у этого элемента дерева нет правого указателя, то
if Const_tab [Curr_term]. Right=0 then
begin
perevod (str_lex,str16);
Const_tab [Curr_term]. Right: =NumConst; // Создаем правый элемент.
Const_tab [NumConst]. value: =str_lex;
Const_tab [NumConst]. nomer: =NumConst;
Const_tab [NumConst]. Val10: =str16;
Const_tab [NumConst]. Left: =0;
Const_tab [NumConst]. Right: =0;
Const_tab [NumConst]. Way: =Const_tab [NumConst]. Way+'R';
end else begin
Const_tab [NumConst]. Way: =Const_tab [NumConst]. Way+'R';
Add_Const (Const_tab [Curr_term]. Right,str_lex); // Если правый указатель существует, то вызываем уже функцию для правого указателя.
end;
end;
procedure Add_Term (Curr_term: integer; str_lex: string); // Процедура добавления идентификаторов в дерево
begin
if NumTerm=1 then // Если корень дерева еще не создан, то создаем его.
begin
Term_tab [NumTerm]. lex: =str_lex;
Term_tab [NumTerm]. nomer: =NumTerm;
Term_tab [NumTerm]. Left: =0;
Term_tab [NumTerm]. Right: =0;
Term_tab [NumTerm]. Way: ='V';
Exit;
end;
if (CompareStr (Term_tab [Curr_term]. lex,str_lex) >0) then // Если значение текущего узла дерева больше добавляемого
if Term_tab [Curr_term]. Left=0 then // если у этого элемента дерева нет левого указателя, то
begin
Term_tab [Curr_term]. Left: =NumTerm; // Создание левого элемента.
Term_tab [NumTerm]. lex: =str_lex;
Term_tab [NumTerm]. nomer: =NumTerm;
Term_tab [NumTerm]. Left: =0;
Term_tab [NumTerm]. Right: =0;
Term_tab [NumTerm]. Way: =Term_tab [NumTerm]. Way+'L';
end else begin
Term_tab [NumTerm]. Way: =Term_tab [NumTerm]. Way+'L';
Add_Term (Term_tab [Curr_term]. Left,str_lex); // Если левый указатель существует, то вызываем уже функцию для левого указателя.
end;
if (CompareStr (Term_tab [Curr_term]. lex,str_lex) <0) then // если у этого элемента дерева нет правого указателя, то
if Term_tab [Curr_term]. Right=0 then
begin
Term_tab [Curr_term]. Right: =NumTerm; // Создаем правый элемент.
Term_tab [NumTerm]. lex: =str_lex;
Term_tab [NumTerm]. nomer: =NumTerm;
Term_tab [NumTerm]. Left: =0;
Term_tab [NumTerm]. Right: =0;
Term_tab [NumTerm]. Way: =Term_tab [NumTerm]. Way+'R';
end else begin
Term_tab [NumTerm]. Way: =Term_tab [NumTerm]. Way+'R';
Add_Term (Term_tab [Curr_term]. Right,str_lex); // Если правый указатель существует, то вызываем уже функцию для правого указателя.
end;
end;
procedure Add_Ident (str: string); // процедура добавления константы
var i: integer;
begin
kod: =Length (str) +2;
hesh: =0;
for i: =1 to Length (str) do hesh: =hesh+ord (str [i]); // вычисление хэш
hesh: =round (hesh/kod); // метод деления
while (Id_tab [hesh]. lex<>'') and (hesh<maxnum) do // пока ячейка занята
begin
Id_tab [hesh]. ssylka: =hesh+1;
hesh: =hesh+1;
end;
Id_tab [hesh]. nomer: =Numid; // запись данных
Id_tab [hesh]. lex: =str;
end;
function Search_Ident (str: string): integer; // функция поиска терминала
var i: integer;
label 1;
begin
kod: =Length (str) +2;
hesh: =0;
for i: =1 to Length (str) do hesh: =hesh+ord (str [i]); // вычисление хэш
hesh: =round (hesh/kod);
1: if str=Id_tab [hesh]. lex then Search_Ident: =Id_tab [hesh]. nomer else // поиск идентификатора
begin
if Id_tab [hesh]. ssylka=0 then Search_Ident: =0 else
begin
hesh: =Id_tab [hesh]. ssylka;
goto 1;
end;
end;
end;
procedure Search_Const (Curr_term: integer; str_lex: string); // Процедура поиска лексем в дереве идентификаторов
begin
Constyes: =0; // флаг: найдена ли лексема
if (NumConst<>0) and (str_lex<>'') then
begin
if (CompareStr (Const_tab [Curr_term]. value,str_lex) >0) and (Const_tab [Curr_term]. Left<>0) then
Search_Const (Const_tab [Curr_term]. Left,str_lex); // рекурсивный "спуск по дереву"
if (CompareStr (Const_tab [Curr_term]. value,str_lex) <0) and (Const_tab [Curr_term]. Right<>0) then
Search_Const (Const_tab [Curr_term]. Right,str_lex);
if Const_tab [Curr_term]. value=str_lex then Constyes: =Const_tab [Curr_term]. nomer;
end;
end;
procedure Search_Term (Curr_term: integer; str_lex: string); // Процедура поиска лексем в дереве идентификаторов
begin
Termyes: =0; // флаг: найдена ли лексема
if (NumTerm<>0) and (str_lex<>'') then
begin
if (CompareStr (Term_tab [Curr_term]. lex,str_lex) >0) and (Term_tab [Curr_term]. Left<>0) then
Search_Term (Term_tab [Curr_term]. Left,str_lex); // рекурсивный "спуск по дереву"
if (CompareStr (Term_tab [Curr_term]. lex,str_lex) <0) and (Term_tab [Curr_term]. Right<>0) then
Search_Term (Term_tab [Curr_term]. Right,str_lex);
if Term_tab [Curr_term]. lex=str_lex then Termyes: =Term_tab [Curr_term]. nomer;
end;
end;
// функция распознавания 16-рич. констант
function FConst (str: string): integer;
var
sost: byte;
begin
sost: =0;
if str [1] ='$' then // распознаём символ '$'
begin
sost: =1;
delete (str,1,1);
end
else exit;
if (str [1] ='+') or (str [1] ='-') then // распознаём знак
begin
sost: =2;
delete (str,1,1)
end
else begin sost: =4; exit; end;
if str='' then exit;
while length (str) >0 do begin
if (str [1] in cifra) or (str [1] in bukva)
then sost: =2 // распознаём буквы или цифры
else begin sost: =4; exit;
end;
delete (str,1,1);
end;
sost: =3;
if sost=3 then FConst: =1 else FConst: =-1;
end;
function termin: integer; // распознаватель терминальных символов
begin
termin: =-1;
for k: =1 to 14 do if Words [k] =Lexem then termin: =3;
for k: =1 to 8 do if Razdel [k] =Lexem then termin: =1;
for k: =1 to 11 do if Operacii [k] =Lexem then termin: =2;
end;
function Rome (str: string): integer; // распознаватель римских констант
var sost: byte;
begin
sost: =0;
if (str [1] ='-') or (str [1] ='+')
then begin sost: =12; delete (str,1,1); end;
if str='' then exit;
if str [1] ='X'
then begin sost: =1; delete (str,1,1) end
else begin
if str [1] ='V' then begin sost: =2; delete (str,1,1) end
else begin
if str [1] ='I' then begin sost: =3; delete (str,1,1) end
else begin sost: =4; exit; end; end; end;
while Length (str) <>0 do begin
case sost of
1: if str [1] ='X'
then begin sost: =5; delete (str,1,1) end
else begin
if str [1] ='V' then begin sost: =2; delete (str,1,1) end
else begin
if str [1] ='I' then begin sost: =3; delete (str,1,1) end
else begin sost: =4; exit; end; end; end;
2: if str [1] ='I'
then begin sost: =7; delete (str,1,1) end
else begin sost: =4; exit; end;
3: if str [1] ='X'
then begin sost: =8; delete (str,1,1) end
else begin
if str [1] ='V' then begin sost: =9; delete (str,1,1) end
else begin
if str [1] ='I' then begin sost: =10; delete (str,1,1) end
else begin sost: =4; exit; end; end; end;
4: exit;
5: if str [1] ='X'
then begin sost: =6; delete (str,1,1) end
else begin
if str [1] ='V' then begin sost: =2; delete (str,1,1) end
else begin
if str [1] ='I' then begin sost: =3; delete (str,1,1) end
else begin sost: =4; exit; end; end; end;
6: if str [1] ='V'
then begin sost: =2; delete (str,1,1) end
else begin
if str [1] ='I' then begin sost: =3; delete (str,1,1) end
else begin sost: =4; exit; end; end;
7: if str [1] ='I'
then begin sost: =10; delete (str,1,1) end
else begin sost: =4; exit; end;
8: begin sost: =4; exit; end;
9: begin sost: =4; exit; end;
10: if str [1] ='I'
then begin sost: =11; delete (str,1,1) end
else begin sost: =4; exit; end;
11: begin sost: =4; exit; end;
end;
end;
if (sost=4) or (sost=12) then Rome: =-1 else Rome: =1;
end;
// функция распознавания идентификаторов
function Ident (str: string): integer;
var
sost: byte;
begin
sost: =0; // реализация конечного автомата
if str [1] in ['a'. 'z'] then
begin
sost: =1;
delete (str,1,1)
end
else exit;
while length (str) >0 do begin
if str [1] in ['a'. 'z','0'. '9','_']
then begin sost: =1; delete (str,1,1); end
else begin sost: =3; exit; end;
end;
sost: =2;
if sost=2 then ident: =1 else ident: =-1;
end;
procedure WriteCode (nomer: integer; lex: string; typ: char; num: integer); // запись в таблицу кодов лексем
begin
Code_Tab [NumLex]. nomer: =nomer;
Code_Tab [NumLex]. Lex: =lex;
Code_Tab [NumLex]. typ: =typ;
Code_Tab [NumLex]. Num: =num;
Code_Tab [NumLex]. numstr: =string_counter+1;
end;
procedure WriteLex (typelex: char); // запись лексем в таблицы
begin
case typelex of
'C': begin // если лексема-16-рич. константа
NumLex: =NumLex+1;
Search_Const (1,Lexem);
if Constyes=0 then // если лексема не найдена
begin
NumConst: =NumConst+1;
Add_Const (1,Lexem);
Const_tab [NumConst]. Typ: ='16-рич. ';
Const_tab [Numconst]. Width: ='2 байта';
WriteCode (NumLex,Lexem,'C',NumConst);
end else // если лексема найдена
begin
WriteCode (NumLex,Lexem,'C',Constyes);
end;
end;
'M': begin // если лексема-римская константа
NumLex: =NumLex+1;
Search_Const (1,Lexem);
if Constyes=0 then // если лексема не найдена
begin
NumConst: =NumConst+1;
Add_Const (1,Lexem);
Const_tab [NumConst]. Typ: ='римск. ';
Const_tab [Numconst]. Width: ='2 байта';
WriteCode (NumLex,Lexem,'C',NumConst);
end else // если лексема найдена
begin
WriteCode (NumLex,Lexem,'C',Constyes);
end;
end;
'I': begin // если лексема-идентификатор
NumLex: =NumLex+1;
y: =Search_Ident ({1,}Lexem);
if y=0 then // если лексема не найдена
begin
NumId: =NumId+1;
WriteCode (NumLex,Lexem,'I',NumId);
Add_Ident (Lexem);
end else WriteCode (NumLex,Lexem,'I',y); // если лексема найдена
end;
'K': begin // если лексема-служебное слово
NumLex: =NumLex+1;
Search_Term (1,Lexem);
if Termyes=0 then // если лексема не найдена
begin
NumTerm: =NumTerm+1;
Add_Term (1,Lexem);
Term_tab [Numterm]. razd: =0;
Term_tab [Numterm]. oper: =0;
Term_tab [Numterm]. slug: =1;
WriteCode (NumLex,Lexem,'T',NumTerm);
end else WriteCode (NumLex,Lexem,'T',Termyes); // если лексема найдена
end;
'R': begin // если лексема-разделитель
NumLex: =NumLex+1;
Search_Term (1,Lexem);
if Termyes=0 then // если лексема не найдена
begin
NumTerm: =NumTerm+1;
Add_Term (1,Lexem);
Term_tab [NumTerm]. razd: =1;
Term_tab [NumTerm]. oper: =0;
Term_tab [NumTerm]. slug: =0;
WriteCode (NumLex,Lexem,'T',NumTerm)
end else WriteCode (NumLex,Lexem,'T',Termyes) // если лексема найдена
end;
'O': begin // если лексема-знак операция
NumLex: =NumLex+1;
Search_Term (1,Lexem);
if Termyes=0 then // если лексема не найдена
begin
NumTerm: =NumTerm+1;
Add_Term (1,Lexem);
Term_tab [Numterm]. razd: =0;
Term_tab [Numterm]. oper: =1;
Term_tab [Numterm]. slug: =0;
WriteCode (NumLex,Lexem,'T',NumTerm)
end else WriteCode (NumLex,Lexem,'T',Termyes) // есди лексема найдена
end;
end;
end;
procedure TForm1. N5Click (Sender: TObject);
var i,pip: integer;
begin
for k: =1 to numid do // обнуление таблицы идентификаторов
begin
id_tab [k]. lex: ='0';
id_tab [k]. nomer: =0;
id_tab [i]. ssylka: =0;
end;
for