Segmentation fault при открытии файла - Free Pascal

uses crt;
 
const bukvy = ['a'..'z','A'..'Z'];
      tsifry = ['0'..'9'];
      operatory = ['=','+','*'];
 
type pVershina = ^Vershina;
 
     Vershina = record
      tip, //1 - peremen./konst.; 2 - znak
      uroveni: byte;
      str: string[16];
      l,pr: pVershina;
      end;
 
     pImea = ^Imea;
 
     Imea = record
      tip: byte; //1 - peremen.; 2 - konst.
      str: string[16];
      sled: pImea;
      end;
 
{-----------------------------------------------------------}
procedure postrTabl(var first: pImea; str: string);
var tek: pImea;
    nov: string;
    i: integer;
begin
first := nil;
i := 1;
 
while i <= length(str) do
 if str[i] in (bukvy + tsifry) then
  begin
  nov := '';
 
  if str[i] in bukvy then
   while (i <= length(str)) and (str[i] in (bukvy + tsifry)) do
    begin
    nov := nov + str[i];
    inc(i);
    end
 
  else
   begin
   while (i <= length(str)) and (str[i] in (tsifry + ['.'])) do
    begin
    nov := nov + str[i];
    inc(i);
    end;
 
   if (i < length(str)) and (lowercase(str[i]) = 'e') then
    begin
    nov := nov + str[i]; //'e'
    inc(i);
    nov := nov + str[i]; //'+' ili '-'
    inc(i);
    while (i <= length(str)) and (str[i] in tsifry) do
     begin
     nov := nov + str[i];
     inc(i);
     end;
    end; //if (i < length...
   end; //else (if nov^.tip = 1)
 
  if first = nil then
   begin
   new(first);
   first^.str := nov;
   if nov[1] in bukvy then
    first^.tip := 1
   else
    first^.tip := 2;
   first^.sled := nil;
   end
  else
   begin
   tek := first;
   while (tek^.str <> nov) and (tek^.sled <> nil) do
    tek := tek^.sled;
   if tek^.str <> nov then
    begin
    new(tek^.sled);
    tek := tek^.sled;
    tek^.str := nov;
    if nov[1] in bukvy then
     tek^.tip := 1
    else
     tek^.tip := 2;
    tek^.sled := nil;
    end;
   end;
  end //if str[i] in (bukvy + tsifry)
 else
  inc(i);
 
writeln('Stroim tablitsu...                                     Gotovo');
end;
{-----------------------------------------------------------}
procedure zapisati(tablImen: pImea; var outF: text);
var tek: pImea;
begin
tek := tablImen;
while tek <> nil do
 begin
 write(outF,tek^.str:16);
 if tek^.tip = 1 then
  writeln(outF,'    Peremennaia s plavaiushei tochkoi')
 else
  if pos('.',tek^.str) > 0 then
   writeln(outF,'    Konstanta s plavaiuschei tochoi')
  else
   writeln(outF,'    Konstanta s fiksirovannoi tochkoi');
 tek := tek^.sled;
 end;
writeln(outF);
writeln('Pishem tablitsu v outF...                              Gotovo');
end;
{-----------------------------------------------------------}
function prioritet(znak: char): byte;
begin
if znak = '=' then
 prioritet := 1
else
 if znak = '+' then
  prioritet := 2
 else
  if znak = '*' then
   prioritet := 3;
end;
{-----------------------------------------------------------}
function estiVTabl(tablImen: pImea; str: string): boolean;
var tek: pImea;
begin
tek := tablImen;
while (tek <> nil) and (tek^.str <> str) do
 tek := tek^.sled;
if tek = nil then
 estiVTabl := false
else
 estiVTabl := true;
end;
{-----------------------------------------------------------}
function naitiMinOperator(str: string): integer;
var i,minPrior,minPos: integer;
begin
i := 1;
minPrior := 0;
while i <= length(str) do
 begin
 if str[i] in operatory then
  begin
  if minPrior = 0 then
   begin
   minPrior := prioritet(str[i]);
   minPos := i;
   end
  else
   if prioritet(str[i]) < minPrior then
    begin
    minPrior := prioritet(str[i]);
    minPos := i;
    end;
  inc(i);
  end
 else
  if str[i] = '(' then
   while str[i] <> ')' do
    inc(i)
  else
   inc(i);
 end;
naitiMinOperator := minPos;
end;
{-----------------------------------------------------------}
procedure ubratiKrSkobki(var str: string);
var str2: string;
    i,k: integer;
begin
if (str[1] <> '(') or (str[length(str)] <> ')') then
 exit;
 
str2 := str;
delete(str2,1,1);
delete(str2,length(str2),1);
i := 1;
k := 0;
while (i <= length(str2)) and (k >= 0) do
 begin
 if str2[i] = '(' then
  inc(k)
 else
  if str2[i] = ')' then
   dec(k);
 inc(i);
 end;
 
if k = 0 then
 str := str2;
end;
{-----------------------------------------------------------}
procedure postrDerevo(var pV: pVershina; str: string; tablImen: pImea);
var posOp: integer;
begin
ubratiKrSkobki(str);
if estiVTabl(tablImen,str) then
 
 begin
 pV^.tip := 1;
 pV^.uroveni := 0;
 pV^.str := str;
 pV^.l := nil;
 pV^.pr := nil;
 end
 
else
 begin
 posOp := naitiMinOperator(str);
 pV^.tip := 2;
 pV^.str := str[posOp];
 new(pV^.l);
 postrDerevo(pV^.l,copy(str,1,posOp-1),tablImen);
 new(pV^.pr);
 postrDerevo(pV^.pr,copy(str,posOp+1,length(str)-posOp),tablImen);
 if pV^.l^.uroveni > pV^.pr^.uroveni then
  pV^.uroveni := pV^.l^.uroveni + 1
 else
  pV^.uroveni := pV^.pr^.uroveni + 1;
 end;
end;
{-----------------------------------------------------------}
function tip(str: string; tablImen: pImea): byte;
var tek: pImea;
begin
tek := tablImen;
while tek^.str <> str do
 tek := tek^.sled;
tip := tek^.tip;
end;
{-----------------------------------------------------------}
procedure bezOptimizatsii(pV: pVershina; var f: text; tablImen: pImea);
begin
if pV^.tip = 1 then
 if tip(pV^.str,tablImen) = 1 then
  writeln(f,pV^.str)
 else
  writeln(f,'=',pV^.str)
else
 if pV^.str = '=' then
  begin
  write(f,'LOAD',#9);
  bezOptimizatsii(pV^.pr,f,tablImen);
  write(f,'STORE',#9);
  bezOptimizatsii(pV^.l,f,tablImen);
  end
 else
  if pV^.str = '+' then
   begin
   bezOptimizatsii(pV^.pr,f,tablImen);
   writeln(f,'STORE',#9,'$',pV^.uroveni);
   write(f,'LOAD',#9);
   bezOptimizatsii(pV^.l,f,tablImen);
   writeln(f,'ADD',#9,'$',pV^.uroveni);
   end
  else
   if pV^.str = '*' then
    begin
    bezOptimizatsii(pV^.pr,f,tablImen);
    writeln(f,'STORE',#9,'$',pV^.uroveni);
    write(f,'LOAD',#9);
    bezOptimizatsii(pV^.l,f,tablImen);
    writeln(f,'MPY',#9,'$',pV^.uroveni);
    end;
end;
{-----------------------------------------------------------}
procedure readOper(var f: text; var comanda,arg: string);
var ch: char;
begin
comanda := '';
arg :='';
if eoln(f) then
 exit;
 
read(f,ch);
while ch <> #9 do
 begin
 comanda := comanda + ch;
 read(f,ch);
 end;
 
readln(f,arg);
end;
{-----------------------------------------------------------}
procedure LOAD_ADD_MPY(var f1,f2: text);
var com1,arg1,com2,arg2: string;
    f3: text;
begin
reset(f1);
rewrite(f2);
com1 := ''; arg1 := '';
readOper(f1,com2,arg2);
if com2 <> 'LOAD' then
 writeln(f2,com2,#9,arg2);
 
while not eof(f1) do
 begin
 com1 := com2; arg1 := arg2;
 readOper(f1,com2,arg2);
 if (com1 = 'LOAD') and ((com2 = 'ADD') or (com2 = 'MPY')) then
  begin
  writeln(f2,com1,#9,arg2);
  writeln(f2,com2,#9,arg1);
  end
 else
  begin
  if com1 = 'LOAD' then
   writeln(f2,com1,#9,arg1);
  if com2 <> 'LOAD' then
   writeln(f2,com2,#9,arg2);
  end;
 end;
 
close(f1);
close(f2);
f3 := f1;
f1 := f2;
f2 := f3;
end;
{-----------------------------------------------------------}
procedure STORE_LOAD(var f1,f2: text);
var com1,arg1,com2,arg2: string;
    f3: text;
begin
reset(f1);
rewrite(f2);
com1 := ''; arg1 := '';
readOper(f1,com2,arg2);
if com2 <> 'STORE' then
 writeln(f2,com2,#9,arg2);
 
while not eof(f1) do
 begin
 com1 := com2; arg1 := arg2;
 readOper(f1,com2,arg2);
 if (com1 = 'STORE') and (com2 = 'LOAD') and (arg1 = arg2) then
  else
   begin
   if com1 = 'STORE' then
    writeln(f2,com1,#9,arg1);
   if com2 <> 'STORE' then
    writeln(f2,com2,#9,arg2);
   end;
 end;
 
if com2 = 'STORE' then
 writeln(f2,com2,#9,arg2);
 
close(f1);
close(f2);
f3 := f1;
f1 := f2;
f2 := f3;
end;
{-----------------------------------------------------------}
function LOAD_STORE_LOAD(var f1,f2: text): boolean;
var com1,arg1,com2,arg2,com3,arg3: string;
    f3: text;
    ch: char;
begin
reset(f1);
rewrite(f2);
com1 := ''; arg1 := '';
readOper(f1,com2,arg2);
readOper(f1,com3,arg3);
if com2 <> 'LOAD' then
 writeln(f2,com2,#9,arg2);
 
while not eof(f1) do
 begin
 com1 := com2; arg1 := arg2;
 com2 := com3; arg2 := arg3;
 readOper(f1,com3,arg3);
 
 if (com1 = 'LOAD') and (com2 = 'STORE') and (com3 = 'LOAD') then
  begin
  writeln(f2,com3,#9,arg3);
 
  while not eof(f1) do
   begin
   readOper(f1,com3,arg3);
   if arg3 = arg2 then
    if com3 <> 'STORE' then
     writeln(f2,com3,#9,arg1)
    else
     break
   else
    writeln(f2,com3,#9,arg3);
   end;
 
  while not eof(f1) do
   begin
   readOper(f1,com3,arg3);
   writeln(f2,com3,#9,arg3);
   end;
 
  close(f1);
  close(f2);
  f3 := f1;
  f1 := f2;
  f2 := f3;
  LOAD_STORE_LOAD := true;
  exit;
  end //if
 
 else
  begin
  if com1 = 'LOAD' then
   writeln(f2,com1,#9,arg1);
  if com2 <> 'LOAD' then
   writeln(f2,com2,#9,arg2);
  end;
 
 end; //while
 
writeln(f2,com3,#9,arg3);
close(f1);
close(f2);
f3 := f1;
f1 := f2;
f2 := f3;
LOAD_STORE_LOAD := false;
end;
{-----------------------------------------------------------}
procedure optimizatsia(var f1: text);
var f2: text;
begin
assign(f2,'DOP2');
LOAD_ADD_MPY(f1,f2);
STORE_LOAD(f1,f2);
while LOAD_STORE_LOAD(f1,f2) do;
erase(f2);
writeln('Optimiziruem kod...                                    Gotovo');
end;
{-----------------------------------------------------------}
procedure dopolniti(var f1,f2: text);
var ch: char;
begin
{$I-} reset(f2); {$I+}
if IOResult <> 0 then
 begin
 writeln('Oshibka!');
 readkey;
 halt;
 end;
while not eof(f2) do
 begin
 read(f2,ch);
 write(f1,ch);
 end;
writeln('Perepisyvaem kod v outF...                             Gotovo');
end;
{-----------------------------------------------------------}
procedure ochistiti(var tablImen: pImea);
var tek: pImea;
begin
while tablImen <> nil do
 begin
 tek := tablImen;
 tablImen := tablImen^.sled;
 dispose(tek);
 end;
writeln('Udaliaem tablitsu...                                   Gotovo');
end;
{-----------------------------------------------------------}
procedure ochistiti(var pV: pVershina);
begin
if pV^.l <> nil then
 ochistiti(pV^.l);
if pV^.pr <> nil then
 ochistiti(pV^.pr);
dispose(pV);
end;
{-----------------------------------------------------------}
procedure vyvesti(pV: pVershina);
begin
writeln(pV^.str,' ',pV^.uroveni);
if pV^.l <> nil then
 vyvesti(pV^.l);
if pV^.pr <> nil then
 vyvesti(pV^.pr);
end;
{-----------------------------------------------------------}
 
var inF,outF,dopF: text;
    stroka: string;
    tablImen: pImea;
    derevo: pVershina;
    ch: char;

begin clrscr;
assign(inF,'INPUT.TXT'); reset(inF);
readln(inF,stroka);
close(inF);
 
postrTabl(tablImen,stroka);
assign(outF,'OUTPUT.TXT'); rewrite(outF);
zapisati(tablImen,outF);
 
new(derevo);
postrDerevo(derevo,stroka,tablImen);
writeln('Stroim derevo...                                       Gotovo');
//vyvesti(derevo);
//readkey;
 
assign(dopF,'DOP'); rewrite(dopF);
bezOptimizatsii(derevo,dopF,tablImen);
close(dopF);
writeln('Pishem neoptimizirovannyi kod v dopF...                Gotovo');
writeln(outF,'Neoptimizirovannyi kod:');
dopolniti(outF,dopF);
writeln(outF);
close(dopF);
optimizatsia(dopF);
writeln(outF,'Optimizirovannyi kod:');
dopolniti(outF,dopF);
 
close(outF);
close(dopF);
erase(dopF);
ochistiti(tablImen);
ochistiti(derevo);
writeln('Udaliaem derevo...                                     Gotovo');
readkey; end.