5.8 Алгоритм обработки ключевого слова Include
нач
пропуск 8 символов
проверяем наличие ‘<’ , ‘>’ и допустимость имени файла
если подключаем stdio.h то InclFlg = правда все
если ошибка в синтаксисе то обработка ошибки с кодом 11
кон
5.9 Алгоритм обработки ключевого слова Union
нач
увеличиваем на 1 nstr2 и kstr2
un = правда
если не v_open то
выводим в вых поток ‘var’
увеличиваем на 1 nstr2 и kstr2
все
NUnStr = текущему номеру строки
увеличиваем на 1 nstr2 и kstr2
кон
5.10 Алгоритм обработки ключевого слова do
нач
увеличиваем на 1 nstr2 и kstr2
выводим в вых поток ‘repeat’
кон
5.10 Алгоритм обработки ключевого слова main
нач
mainflg = правда
проверка наличия ‘(‘ и ‘)’
если ошибка в синтаксисе то обработка ошибки с кодом 5
кон
5.11 Алгоритм обработки ключевого слова define
нач
увеличиваем на 1 nstr2 и kstr2
если это первый дефайн то
выводим в вых поток ‘const’
увеличиваем на 1 nstr2 и kstr2
иначе def = правда
все
выводим в вых поток все до пробела или до конца строки
выводим в вых поток “=’”
выводим в вых поток все до конца строки
выводим в вых поток “’”
кон
5.12 Алгоритм обработки ключевого слова while
нач
увеличиваем на 1 nstr2 и kstr2
проверяем на ‘(‘
проверяем на le2
проверяем на ‘)’
проверяем на ‘;’
если ошибка в синтаксисе то обработка ошибки с кодом 5
выход
наче
выводим в вых поток 'until not('+ostr+');'
все
кон
5.12 Алгоритм обработки открывающейся операторной скобки
нач
увеличиваем на 1 nstr2 и kstr2
выводим в вых поток 'begin’
кон
5.13Алгоритм обработки закрывающейся операторной скобки
нач
если не закрыт union то выход все
увеличиваем на 1 nstr2 и kstr2
выводим в вых поток 'end’
если это последняя строка то выводим вых поток '.’ иначе
выводим в вых поток ';’
все
кон
5.14 Алгоритм обработки ключевого слова printf
нач
если не подключена stdio.h то вывод сообщения и выход
все
проверка синтаксиса
проверка совпадения кол-ва переменных и кол-ва ‘%f’
если ошибка в синтаксисе то обработка ошибки с кодом 8
выход
все
запоминаем начало форматной строки и начало переменных
цикл от начала форматной строки до ‘”’ или конца строки
если ‘%f’ то вывод в вых поток ‘write(‘ +имя переменной+’);’
иначе
если \n то вывод ‘writeln;’
иначе
вывод ‘write(‘ + текущий символ+’);’
кц
кон
5.15 Алгоритм проверки ae2 приведен в методичке. Принцип алгоритма проверки le2 аналогичен принципу алгоритма проверки ae2;
Структура программы:
main ReadFile
Trans
Writefile
fcomment
ferror
fwile
fPrisv
fOsk
fcSk
ffloat
fprintf
fdefine
fPrisv
fInclude fUnion
fDo
fMain
le2
fae
Назначение основных подпрограмм
ReadFile чтение и запись в массивtext1 из исходного файла
Trans основная подпрограмма транслятор
WriteFile запись в выходной файл массиваtext2
Ferror обработка ошибки
Fcomment обработка комментария
Kw выделение ключевого слова
CheckSk подсчет кол-ва открывающихся и закрывающихся фигурных скобок
Ffloat обработка ключевого слова float
FInclude обработка ключевого слова Include
FUnion обработка ключевого слова Union
Fdo обработка ключевого слова do
Fmain обработка ключевого слова main
Fprisv обработка присваивания
Fdefine обработка ключевого слова define
Fwhile обработка ключевого словаwhile
FOSk обработка открывающейся операторной скобки
FCSk обработка закрывающейся операторной скобки
Fprintf обработка ключевого слова fprintf
le2 обработка логического выражения
Fae обработка арифметического выражения
Текст программы конвертора на ПАСКАЛЕ
{define debug}
{$M $4000,0,0}
uses crt;
Type
kwType=(kwNothing, kwOpSk, kwClSk, kwMain, kwDo, kwWhile, kwPrintf, kwDefine, kwUnion, kwInclude, kwFloat);
const
os='{Error:';
KWarray:array [kwOpSk..kwFloat] of string
=('{','}','main','do','while','printf','#define','union','#include','float');
MaxStr=100;
azbuki=['a'..'z','A'..'Z','_'];
oo=['<','>','=','!'];
signs=['+','-','/','*'];
zif=['0'..'9'];
var_symb:set of #0..#255=['a'..'z','A'..'Z','_','-','0'..'9'];
var
text1, text2:array [1..MaxStr] of string {вх и вых массивы};
kstr, kstr2{кол-во строк вх и вых},
Nstr,Npos {позиция во вх массиве},
Nstr2{Тек поз в вых мас},
kerr{к-во ошибок}:integer;
Fname1,Fname2:string; {имена файлов с путями}
f1,f2:text; {файловые переменные}
TypeComment:integer; {// - 1, /* ... */ - 2}
Ae:string[80]; {строка для ae и le}
Pf:integer; {позиция для ae и le}
Flag,def,v_open,mainflg,InclFlg,print,un:boolean; {всякие флаги}
ostr:string; {выходная строка для le}
qwe,l:integer; {еще позиция для le и длина строки}
fl:boolean; {флаг для le}
perem:array [1..20] of string; {массив переменных}
KolPer:integer; {кол-во переменных}
i:integer; {счетчик для циклов}
NUnStr:integer; {строка, в которой начинается union}
nfl:char; {номер переменной в union}
procedure CopyN(n:integer); Forward;
procedure OutStr(s:string); Forward;
procedure SkipSp; Forward;
procedure ferror(err:integer); Forward;
function IsComment:boolean; Forward;
function Fae:boolean;forward;
{=======================================================}
{=================== AE ===============}
{=======================================================}
{=======пропуск пустых символов============================}
procedure space(ert:string);
begin
while(ert[qwe]=' ')and(qwe<=length(ert))and(ert[qwe]<>';') do
inc(qwe);
end;
{=========== функция проверки знака ================}
function Znak:Boolean;
begin
Znak:=ae[pf]in ['+','-'];
end;
{======== функция проверки цифры============}
function IsDigit(ch:Char):Boolean;
begin
IsDigit:=Ch in ['0'..'9'];
end;
{=============функция проверки латинской буквы=============}
function IsAlpha(ch:char):Boolean;
begin
IsAlpha:=Ch in ['A'..'Z','a'..'z'];
end;
{===========проверка константы========================}
function Fconst:Boolean;
begin
Flag:=True;
while (pf<=Length(ae))and IsDigit(ae[pf]) do
begin
ostr:=ostr+ae[pf];
Inc(pf);
Flag:=False;
end;
if ae[pf]='.' then
begin
ostr:=ostr+ae[pf];
inc(pf);
while(pf<=length(ae)) and IsDigit(ae[pf]) do
begin
ostr:=ostr+ae[pf];
Inc(pf);
Flag:=False;
end;
end;
if Flag then
begin
Fconst:=True;
exit;
end;
if ae[pf]='E' then
begin
ostr:=ostr+ae[pf];
Inc(pf);
if Znak then
begin
ostr:=ostr+ae[pf];
Inc(pf);
end;
if not(IsDigit(ae[pf])) then
begin
Fconst:=True;
Exit;
end;
while (pf<=Length(ae)) and IsDigit(ae[pf]) do
begin
ostr:=ostr+ae[pf];
Inc(pf);
end;
end;
Fconst:=False;
end;
{=============== проверка идентификатора =================}
function Fid:Boolean;
begin
if (pf<=Length(ae)) and not IsAlpha(ae[pf]) then
begin
Fid:=True;
Exit;
end;
while (pf<=Length(ae)) and (IsAlpha(ae[pf]) or IsDigit(ae[pf])) do
begin
ostr:=ostr+ae[pf];
inc(pf);
end;
Fid:=False;
end;
{========== проверка переменной ===============}
function Fper:Boolean;
begin
if Fid then
begin
Fper:=True;
Exit;
end;
if ae[pf]='[' then
begin
repeat
ostr:=ostr+ae[pf];
inc(pf);
if Fae then
begin
Fper:=True;
Exit;
end;
until (ae[pf]<>',');
if ae[pf] <>']' then
begin
Fper:=True;
Exit;
end;
ostr:=ostr+ae[pf];
Inc(pf);
end;
Fper:=False;
end;
{============== проверка множителя =======================}
function Fmnog:Boolean;
begin
if ae[pf]='(' then
begin
ostr:=ostr+ae[pf];
Inc(pf);
if Fae then
begin
Fmnog:=True;
Exit;
end;
if ae[pf]=')' then
begin
ostr:=ostr+ae[pf];
inc(pf);
end
else
begin
Fmnog:=true;
exit;
end;
end
else
if Fper and Fconst then
begin
Fmnog:=True;
Exit;
end;
Fmnog:=False;
end;
{=========== проверка слагаемого ====================}
function Fslag:boolean;
begin
while True do
if Fmnog then
begin
Fslag:=True;
Exit;
end
else
if (ae[pf]='*')or (ae[pf]='/') then
begin
ostr:=ostr+ae[pf];
Inc(pf);
end
else
begin
Fslag:=False;
Exit;
end;
end;
{========= ae ====================}
function Fae:boolean;
begin
if Znak then
begin
ostr:=ostr+ae[pf];
Inc(pf);
end;
while True do
begin
qwe:=pf;
space(ae);
pf:=qwe;
if Fslag then
begin
Fae:=True;
Exit;
end;
if Znak then
begin
ostr:=ostr+ae[pf];
inc(pf);
end
else
begin
Fae:=False;
Exit;
end;
end;
end;
procedure go;
begin
if (pf<=l) then
begin
ostr:=ostr+ae[pf];
inc(pf);
end;
end;
function le2:boolean; forward;
{============ обработка ! ============}
function nots:boolean;
begin
if (ae[pf]='!')and(ae[pf+1]<>'=') then
begin
nots:=true;
ostr:=ostr+'not';
inc(pf);
qwe:=pf;
while(ae[qwe]=' ')and(qwe<=length(ae))and(ae[qwe]<>';') do inc(qwe);
pf:=qwe;
exit;
end
else
begin
nots:=false;
exit;
end;
end;
{============= обработка || ===========================}
function ors:boolean;
begin
qwe:=pf;
while(ae[qwe]=' ')and(qwe<=length(ae))and(ae[qwe]<>';') do inc(qwe);
pf:=qwe;
if ((ae[pf]='|')and(ae[pf+1]='|')) then
begin
pf:=pf+2;
qwe:=pf;
while(ae[qwe]=' ')and(qwe<=length(ae))and(ae[qwe]<>';') do inc(qwe);
pf:=qwe;
if (ae[pf]='(')or(ae[pf]in azbuki)or(ae[pf]='!') then
begin
ostr:=ostr+' or ';
ors:=true;
fl:=false;
qwe:=pf;
while(ae[qwe]=' ')and(qwe<=length(ae))and(ae[qwe]<>';') do inc(qwe);
pf:=qwe;
exit;
end
else
begin
ostr:=os+'нет 1 операнда для || : "'+ae+'"}';
ors:=false;
exit;
end;
end
else
ors:=false;
end;
{=========== обработка && ================}
function ands:boolean;
begin
qwe:=pf;
while(ae[qwe]=' ')and(qwe<=length(ae))and(ae[qwe]<>';') do inc(qwe);
pf:=qwe;
if ((ae[pf]='&') and (ae[pf+1]='&')) then
begin
inc(pf,2);
qwe:=pf;
while(ae[qwe]=' ')and(qwe<=length(ae))and(ae[qwe]<>';') do inc(qwe);
pf:=qwe;
if (ae[pf]='(')or(ae[pf]in azbuki)or(ae[pf]='!') then
begin
ostr:=ostr+' and ';
ands:=true;
qwe:=pf;
while(ae[qwe]=' ')and(qwe<=length(ae))and(ae[qwe]<>';') do inc(qwe);
pf:=qwe;
exit;
end
else
begin
ostr:=os+'нет 1 операнда для && : "'+ae+'"}';
ands:=false;
exit;
end;
end
else
ands:=false;
end;
{========== проверка знака сравнения ====================}
function ooo:boolean;
begin
qwe:=pf;
while(ae[qwe]=' ')and(qwe<=length(ae))and(ae[qwe]<>';') do inc(qwe);
pf:=qwe;
if (ae[pf] in oo) then
begin
ooo:=false;
if (ae[pf]='=') and (ae[pf+1]='=') then
begin
ostr:=ostr+'=';
inc(pf,2);
end
else
if ae[pf+1] in oo then
begin
if (ae[pf]='!')and(ae[pf+1]='=')then
begin ostr:=ostr+'<>'; inc(pf,2); end
else
begin
ostr:=ostr+ae[pf]+ae[pf+1];
inc(pf,2);
end
end
else
begin
go;
qwe:=pf;
while(ae[qwe]=' ')and(qwe<=length(ae))and(ae[qwe]<>';') do inc(qwe);
pf:=qwe;
exit;
end
end
else
ooo:=true;
end;
{=============== функция проверки:знак ли текущий символ ========}
function sign:boolean;
begin
if (pf<=l) then
begin
if (ae[pf] in signs) then sign:=true
else sign:=false;
end;
end;
{=========== проверка слагаемого ===========================}
function slag1:boolean;
begin
if ae[pf]='(' then
begin
go;
if fl then fl:=false;
while (ae[pf]<>')')and(pos(os,ostr)=0)do
begin
if (not le2) and (pf<l)then
begin
slag1:=false;
if (pos(os,ostr)=0) and (ae[pf]<>')')or (pf=l) then
begin write(ae[pf],pf);
ostr:=os+'нет ")" : "'+ae+'"}';
exit;
end
else if ae[pf]=')' then
begin
slag1:=true;
go;
exit;
end;
end
else
if pf=l then exit;
end;
end
else
begin
slag1:=false;
exit;
end;
end;
{============== функция проверки:цифра ли текущий символ ============}
function consta:boolean;
begin
if (pf<=l) then
begin
if (ae[pf]in zif)and not(ae[pf+1]in azbuki) then
begin
consta:=true;
go;
end
else if (ae[pf]in zif) then
begin
consta:=false;
ostr:=os+'идентификатор начинается с цифры:: "'+ae+'"}';
exit;
end;
end;
end;
{==========================================}
function es1:boolean;
begin
if (not ors and (pos(os,ostr)=0))and
(not ands and (pos(os,ostr)=0))and
(not nots and (pos(os,ostr)=0))then
begin
es1:=false;
exit;
end
else
es1:=true;
end;
{================= проверка на букву ===================}
function alpha:boolean;
begin
if (pf<=l) then
begin
if (ae[pf] in azbuki) then alpha:=true
else alpha:=false;
end;
end;
{========== le ====================}
function le2:boolean;
begin
l:=length(ae);
while (pos(os,ostr)=0) and(pf<=l)and (ae[pf]<>';')do{пока не ошибка и не `;`}
begin
if (slag1 or es1)and (pos(os,ostr)=0)then le2:=true
else if not(consta or sign) then go
else if not(ooo) then le2:=true
else
if Fae then
begin
le2:=false; {то ошибка и выход из функции}
exit;
end
else
le2:=true;
end;
end;
{======= проверка "(" ===== TRUE - OK ============}
function IsOSk:boolean;
begin
if text1[nstr,npos]='(' then
IsoSk:=true
else
IsoSk:=false;
end;
{======= проверка ")" ===== TRUE - OK ============}
function IsCSk:boolean;
begin
if text1[nstr,npos]=')' then
IscSk:=true
else
IscSk:=false;
end;
{======= проверка ";" ===== TRUE - OK ============}
function IsTz:boolean;
begin
if text1[nstr,npos]=';' then
Istz:=true
else
Istz:=false;
end;
{=========== Обработка откр фиг ск ===============}
Procedure fOpSk;
begin
if un then exit;
inc(nstr2);
inc(kstr2);
OutStr('Begin');
npos:=npos+1;
SkipSp;
if npos<=length(text1[nstr]) then
ferror(1);
end;
{=========== Обработка закр фиг ск ============}
Procedure fClSk;
begin
if un then exit;
inc(nstr2);
inc(kstr2);
OutStr('End');
npos:=npos+1;
if nstr=kstr then
OutStr('.')
else
OutStr(';');
SkipSp;
if npos<=length(text1[nstr]) then
ferror(1);
end;
{====================== Обработка присваивания ============}
function fPrisv:boolean;
var i,kol_prisv,kol_tz:integer;
begin
if pos('=',text1[nstr])>0 then
begin
fPrisv:=true;
inc(nstr2);
inc(kstr2);
i:=npos; kol_prisv:=0; kol_tz:=0;
while i<=length(text1[nstr]) do
begin
if text1[nstr,i]='=' then inc(kol_prisv);
if text1[nstr,i]=';' then inc(kol_tz);
inc(i);
end;
if (kol_prisv>1)or(kol_tz<>1) then begin
ferror(13);
exit;
end;
ae:=copy(text1[nstr],npos,pos('=',text1[nstr])-npos);
pf:=1;
if fper or (pf<=length(ae)) then
begin
ferror(13);
exit;
end;
copyn(pos('=',text1[nstr])-npos);
SkipSp;
inc(npos);
SkipSp;
ae:=copy(text1[nstr],npos,pos(';',text1[nstr])-npos);
pf:=1;
if fae or (pf<=length(ae)) then
begin
ferror(13);
exit;
end;
OutStr(':=');
copyn(pos(';',text1[nstr])-npos);
outstr(';');
inc(npos);
skipsp;
if npos<=length(text1[nstr]) then
ferror(1);
end
else
begin
fPrisv:=false;
exit;
end;
end;
{=========== Обработка "main" ===============}
Procedure fMain;
begin
mainflg:=true;
npos:=npos+4;
SkipSp;
if IsOSk then
npos:=npos+1
else
begin
inc(nstr2);
inc(kstr2);
fError(5);
exit;
end;
SkipSp;
if IsCSk then
npos:=npos+1
else
begin
inc(nstr2);
inc(kstr2);
fError(5);
exit;
end;
skipsp;
if npos<=length(text1[nstr]) then
begin
inc(nstr2);
inc(kstr2);
ferror(1);
end;
end;
{=========== Обработка "do" ===============}
Procedure fDo;
begin
inc(nstr2);
inc(kstr2);
Outstr('repeat');
npos:=npos+2;
skipsp;
if npos<=length(text1[nstr]) then
ferror(1);
end;
{=========== Обработка "while" ===============}
Procedure fWhile;
begin
inc(nstr2);
inc(kstr2);
npos:=npos+5;
skipsp;
if IsOSk then inc(npos) else
begin
ferror(7);
exit;
end;
SkipSp;
ae:=text1[nstr]; pf:=npos;
ostr:='';
if le2 then;
npos:=pf;
SkipSp;
if IsCSk then inc(npos) else
begin
ferror(7);
exit;
end;
SkipSp;
if not IsTz then
begin
ferror(7);
exit;
end;
OutStr('until not('+ostr+');');
inc(npos);
skipsp;
if npos<=length(text1[nstr]) then
ferror(1);
end;
{=========== Обработка "printf" ===============}
Procedure fPrintf;
var
np:integer;
begin
ostr:='';
inc(nstr2);
inc(kstr2);
if not InclFlg then
begin
inc(kerr);
OutStr('{Error: Function "printf" should have a prototype}');
exit;
end;
inc(npos,6);
skipsp;
if IsOSk then inc(npos) else
begin
ferror(8);
exit;
end;
skipsp;
if text1[nstr,npos]='"' then inc(npos) else
begin
ferror(8);
exit;
end;
while (text1[nstr,npos]<>'"') and
(npos<=length(text1[nstr])) do inc(npos);
if npos>length(text1[nstr]) then
begin
ferror(8);
exit;
end else inc(npos,2);
np:=npos;
repeat
skipsp;
while text1[nstr,npos] in var_symb do inc(npos);
skipsp;
if (text1[nstr,npos]=',') and (text1[nstr,npos+1]<>')') then inc (npos);
until IsCSk or (npos>length(text1[nstr]));
if (npos>length(text1[nstr]))or not(iscsk) then
begin
ferror(8);
exit;
end;
inc(npos);
skipsp;
if not istz then
begin
ferror(8);
exit;
end else inc(npos);
skipsp;
if npos<=length(text1[nstr]) then
ferror(1);
{========= обработка ==============}
npos:=pos('"',text1[nstr])+1;
print:=false;
while text1[nstr,npos]<>'"' do
begin
if pos('%f',copy(text1[nstr],npos,length(text1[nstr])-npos+1)) = 1 then
begin
if print then
begin
print:=false;
outstr(chr(39)+'); ');
end;
inc(npos,2);
ostr:='write(';
while (text1[nstr,np]<>',')
and(text1[nstr,np]<>')')
and (np<=length(text1[nstr]))
and (text1[nstr,np]<>';') do
begin
ostr:=ostr+text1[nstr,np];
inc(np);
end;
if length(ostr)=length('write(') then
begin
ferror(8);
exit;
end
else
ostr:=ostr+'); ';
inc(np);
end else
if pos('\n',copy(text1[nstr],npos,length(text1[nstr])-npos+1)) = 1 then
begin
if print then
begin
print:=false;
outstr(chr(39)+'); ');
end;
ostr:='writeln; ';
inc(npos,2);
end
else
begin
if not print then
begin
ostr:='write('+chr(39)+text1[nstr,npos];
inc(npos);
print:=true;
end else
begin
ostr:=text1[nstr,npos];
inc(npos);
end;
end;
Outstr(ostr);
end;
if text1[nstr,np] in var_symb then ferror(8);
end;
{=========== Обработка "#define" ===============}
Procedure fDefine;
begin
inc(nstr2);
inc(kstr2);
if not def then
begin
outstr('const');
inc(nstr2);
inc(kstr2);
end;
npos:=npos+7;
skipsp;
while text1[nstr,npos]<>' ' do copyn(1);
outstr(' = '+chr(39));
skipsp;
copyn(length(text1[nstr])-npos+1);
outstr(chr(39)+';');
def:=true;
end;
{=========== Обработка "union" ===============}
Procedure fUnion;
begin
un:=true;
inc(nstr2);
inc(kstr2);
if not v_open then
begin
outstr('var');
inc(nstr2);
inc(kstr2);
v_open:=true;
end;
NUnStr:=nstr2;
inc(nstr2);
inc(kstr2);
end;
{=========== Обработка "#include" ===============}
Procedure fInclude;
begin
npos:=npos+8;
SkipSp;
if text1[nstr,npos]='<' then inc(npos) else begin
ferror(11);
exit;
end;
if (pos('>',text1[nstr])>0)
and (pos('>',text1[nstr])-pos('<',text1[nstr])<=12) then
npos:=pos('>',text1[nstr])+1 else begin
ferror(11);
exit;
end;
SkipSp;
if npos<=length(text1[nstr]) then begin
ferror(11);
exit;
end;
if pos('stdio.h',text1[nstr])>0 then InclFlg:=true;
end;
{=========== Обработка "float" ===============}
Procedure fFloat;
var i,j:integer;
er:boolean;
str:string;
begin
er:=true;
inc(nstr2);
inc(kstr2);
if un then begin
outstr(nfl+':(');
inc(nfl);
end;
if not v_open then
begin
outstr('var');
inc(nstr2);
inc(kstr2);
end;
npos:=npos+5;
skipsp;
i:=npos;
while (npos<=length(text1[nstr])) and (text1[nstr,npos] in var_symb) do inc(npos);
skipsp;
if IsTz then
begin
npos:=i;
str:=copy(text1[nstr],npos,pos(';',text1[nstr])-npos);
j:=1;
while (j<=kolper)and(perem[j]<>str) do inc(j);
if j>KolPer then
begin
KolPer:=KolPer+1;
Perem[KolPer]:=Str;
copyn(pos(';',text1[nstr])-npos);
if not un then
Outstr(':real;')
else
Outstr(':real);');
er:=false;
end
end
else
if text1[nstr,npos]='[' then
begin
inc(npos);
skipsp;
while IsDigit(text1[nstr,npos]) do inc(npos);
skipsp;
if text1[nstr,npos]=']' then
begin
inc(npos);
if text1[nstr,npos]=';' then
begin
npos:=i;
str:='';
while (text1[nstr,npos] in var_symb) do
begin
str:=str+text1[nstr,npos];
inc(npos);
end;
j:=1;
while (j<=kolper)and(perem[j]<>str) do inc(j);
if j>KolPer then
begin
KolPer:=KolPer+1;
Perem[KolPer]:=Str;
npos:=pos('[',text1[nstr])+1;
OutStr(str);
outstr(':array [1..');
copyn(pos(']',text1[nstr])-npos);
if not un then
outstr('] of real;')
else
Outstr('] of real);');
if pos(']',text1[nstr])-pos('[',text1[nstr])<>1 then er:=false;
end;
end;
end;
end;
if er then ferror(12);
v_open:=true;
end;
{=========== проверка к-ва открывающихся и закрывающихся скобок
============= TRUE - ошибка ====================================}
function CheckSk:boolean;
var i,j, nopen, nclose:integer;
begin
nopen:=0; nclose:=0;
for nstr:=1 to kstr do
for j:=1 to length(text1[nstr]) do
if text1[nstr,j]='{' then
nopen:=nopen+1
else
if text1[nstr,j]='}' then
nclose:=nclose+1;
if nopen=nclose then
CheckSk:=false
else
CheckSk:=true;
nstr:=1;
end;
{===============================================================}
{===================== распознавание ключевого слова ===========}
{===============================================================}
function kw:kwType;
begin
kw:=kwNothing;
if (pos(kwArray[kwOpSk], text1[nstr])=npos) then
kw:=kwOpSk
else
if (pos(kwArray[kwClSk], text1[nstr])=npos) then
kw:=kwClSk
else
if (pos(kwArray[kwMain], text1[nstr])=npos)
then
begin
if (text1[nstr,npos+length(kwArray[kwMain])]=' ')
or
(text1[nstr,npos+length(kwArray[kwMain])]='(')
or
(text1[nstr,npos+length(kwArray[kwMain])]=chr(0)) then
kw:=kWMain;
end
else
if (pos(kwArray[kwDo], text1[nstr])=npos)
then
begin
if (text1[nstr,npos+length(kwArray[kwDo])]=' ') or
(text1[nstr,npos+length(kwArray[kwDo])]=chr(0)) then
kw:=kWDo;
end
else
if (pos(kwArray[kwWhile], text1[nstr])=npos)
then
begin
if (text1[nstr,npos+length(kwArray[kwWhile])]=' ')
or
(text1[nstr,npos+length(kwArray[kwWhile])]='(')
or
(text1[nstr,npos+length(kwArray[kwWhile])]=chr(0)) then
kw:=kWWhile;
end
else
if (pos(kwArray[kwprintf], text1[nstr])=npos)
then
begin
if (text1[nstr,npos+length(kwArray[kwprintf])]=' ')
or
(text1[nstr,npos+length(kwArray[kwprintf])]='(')
or
(text1[nstr,npos+length(kwArray[kwprintf])]=chr(0)) then
kw:=kWprintf;
end
else
if (pos(kwArray[kwdefine], text1[nstr])=npos)
then
begin
if (text1[nstr,npos+length(kwArray[kwdefine])]=' ')
or
(text1[nstr,npos+length(kwArray[kwdefine])]='(')
or
(text1[nstr,npos+length(kwArray[kwdefine])]=chr(0)) then
kw:=kWdefine;
end
else
if (pos(kwArray[kwUnion], text1[nstr])=npos)
then
begin
if (text1[nstr,npos+length(kwArray[kwUnion])]=' ')
or
(text1[nstr,npos+length(kwArray[kwUnion])]='(')
or
(text1[nstr,npos+length(kwArray[kwUnion])]=chr(0)) then
kw:=kWUnion;
end
else
if (pos(kwArray[kwInclude], text1[nstr])=npos)
then
begin
if (text1[nstr,npos+length(kwArray[kwInclude])]=' ')
or
(text1[nstr,npos+length(kwArray[kwInclude])]='(')
or
(text1[nstr,npos+length(kwArray[kwInclude])]=chr(0)) then
kw:=kWInclude;
end
else
if (pos(kwArray[kwFloat], text1[nstr])=npos)
then
if (text1[nstr,npos+length(kwArray[kwFloat])]=' ')
or
(text1[nstr,npos+length(kwArray[kwFloat])]='(')
or
(text1[nstr,npos+length(kwArray[kwFloat])]=chr(0)) then
kw:=kWFloat;
end;
{====================== проверка начала коментария ==============}
function IsComment:boolean;
begin
IsComment:=false;
if pos('/*', text1[nstr])=npos then
begin
IsComment:=true;
TypeComment:=2;
npos:=npos+2;
end
else
if pos('//', text1[nstr])=npos then
begin
IsComment:=true;
TypeComment:=1;
npos:=npos+2;
end;
end;
{=============== Обработка коментария =====================}
procedure fComment;
begin
inc(nstr2);
inc(kstr2);
outstr('{');
if TypeComment=1 then
begin
copyn(length(text1[nstr])-npos+1);
outstr('}');
end
else
begin
if pos('*/',text1[nstr])=0 then ferror(3);
copyn(pos('*/',text1[nstr])-npos);
npos:=pos('*/',text1[nstr])+2;
outstr('}');
skipsp;
if npos<=length(text1[nstr]) then ferror(1);
end;
end;
{===================================================}
{=============== Обработка ошибок ==================}
{===================================================}
procedure ferror(err:integer);
begin
{Список ашипак:
1: после оператора есть символы
2: Количество открывающихся скобок не соответствует к-ву закрывающихся
3: На строке N',nstr,' не найден конец коментария!
4: неопознанный идентификатор и не присваивание
Ашипки в операторах:
5: MAIN
7: WHILE
8: PRINTF
10:UNION
11:#INCLUDE
12:FLOAT
13: Присваивание
}
case err of
1:begin
OutStr('{Error: После оператора есть символы "');
copyn(length(text1[nstr])-npos+1);
OutStr('"}');
end;
2:begin
writeln('Количество "{" не соответствует к-ву "}"');
writeln('Program aborted!!!');
halt;
end;
3:begin
writeln('На строке N',nstr,' не найден конец коментария!');
writeln('Program aborted!!!');
halt;
end;
4:begin
inc(nstr2);
inc(kstr2);
OutStr('{Error: неизвестный оператор "');
CopyN(length(text1[nstr]));
OutStr('"}');
end;
5:begin
OutStr('{Error: ошибка в main: "');
OutStr(text1[nstr]);
OutStr('"}');
end;
6:begin
end;
7:begin
OutStr('{Error: ошибка в while: "');
OutStr(text1[nstr]);
OutStr('"}');
end;
8:begin
text2[nstr2]:='{Error: ошибка в printf: "'+text1[nstr]+'"}';
end;
9:begin
end;
11:begin
inc(nstr2);
inc(kstr2);
text2[nstr2]:='{Ошибка в include: "'+text1[nstr]+'"}';
end;
12:begin
text2[nstr2]:='{Ошибка в float: "'+text1[nstr]+'"}';
end;
13:begin
text2[nstr2]:='{Ошибка в присваивании: "'+text1[nstr]+'"}';
end;
end;
kerr:=kerr+1;
end;
{======= запись в выходной поток строки s ============}
procedure OutStr(s:string);
begin
text2[nstr2]:=text2[nstr2]+s;
end;
{============ Копирование n символов и сдвиг курсора ================}
procedure CopyN(n:integer);
begin
text2[nstr2]:=text2[nstr2]+copy(text1[nstr],npos,n);
npos:=npos+n;
end;
{===================== пропуск пробелов ============================}
procedure SkipSp;
begin
while (text1[Nstr,Npos]=' ')
and
(npos<=length(text1[Nstr]))
do inc(npos);
end;
{===================== чтение файла в массив ============================}
procedure readfile;
var ch:char;
begin
{$ifndef debug}
writeln('Имя файла с путем: ');
readln(Fname1);
{$else}
Fname1:='F:\KURSOVIK\1.c';
{$endif}
assign(f1,FName1 );
{$i-}
reset(f1);
{$i+}
if IoResult<>0 then
begin
writeln('Файл '+fname1+' не найден.');
Writeln('Press any key to continue.');
ch:=readkey; Halt;
end;
kstr:=0;
while not eof(f1) do
begin
inc(kstr);readln(f1,text1[kstr]);
end;
close(f1);
end;
{================== запись массива в файл ============================}
procedure writefile;
var
i:integer;
ch:char;
begin
{$ifndef debug}
writeln('Укажите имя выходного файла:');
readln(Fname2);
{$else}
Fname2:='F:\KURSOVIK\1.PAS';
{$endif}
assign(f2,Fname2);
{$i-}
rewrite(f2);
{$i+}
if IoResult<>0 then
begin
writeln('Файл',Fname2,'не найден .Повторите ввод.');
ch:=readkey; Halt;
end;
for i:=1 to kstr2 do
begin
writeln(f2,Text2[i]);
end;
writeln ('Число ошибочных операторов: ',kerr);
writeln('Число строк в исходном файле: ',kstr);
writeln('Число строк в выходном файле: ', kstr2);
close(f2);
end;
{============================================================}
{===================== основная процедура ===================}
{============================================================}
procedure trans;
var i,j:integer;
begin
for i:=1 to kstr do text2[i]:='';
if CheckSk then ferror(2);
while nstr<=kstr do
begin
npos:=1;
SkipSp;
if npos<=length(text1[nstr]) then
if IsComment then
fComment
else
if Kw<>kwNothing then
case kw of
kwOpSk:fOpSk;
kwClSk:fClSk;
kwMain:fMain;
kwDo:fDo;
kwWhile:fWhile;
kwPrintf:fPrintf;
kwDefine:fDefine;
kwUnion:fUnion;
kwInclude:fInclude;
kwFloat:fFloat;
end
else
if not fPrisv then
if un then
begin
text2[NUnStr]:=copy(text1[nstr],npos,pos(';',text1[nstr])-npos);
text2[NUnStr]:=text2[NUnStr]+':record';
text2[NUnStr+1]:=' case integer of';
inc(nstr2);
inc(kstr2);
Outstr('end;');
un:=false;
end
else
fError(4);
inc(nstr);
end;
if not mainflg then
Writeln('В исходной программе на C нет функции main!!!');
end;
{main}
begin
clrscr;
kstr:=0; kerr:=0; Nstr:=1; Npos:=1; Nstr2:=0; Kstr2:=0;
def:=false; mainflg:=false; v_open:=false; InclFlg:=false;
KolPer:=0; un:=false; nfl:='0';
readfile;
trans;
writefile;
end.
Распечатка тестового примера и его трансляции
#include <stdio.h>
#define test test_new
#define test2 test_new2
float mas[20];
float per;
float per1[8];
union
{
float cvar3;
float un_array[10];
}
var_union;
main()
{
per=4+34.8+1E-3;
mas[1]=2;
per1[3]=1.4;
//COMMENTS... zzzzzzzzz
/*comment2*/
do
{
per=per-2.3;
do
{
per=per+2;
printf("per= %f\n",per);
}
while (per<-1.2E12/(56*3));
}
while (!(per<7));
{
}
}