Не могу найти ошибку (Segmentation fault)

program format;
uses crt;
var infile,outfile:text;
 
function agree():boolean;                               // да или нет
var f2:boolean;
    c:char;
begin
  f2:=false;
  while not f2 do
   begin
     c:=readkey;
     if c=#0
     then
      c:=readkey;
     if (c='Y') or (c='y')
     then
      begin
        agree:=true;
        f2:=true;
      end
     else
     if (c='N') or (c='n')
     then
      begin
        agree:=false;
        f2:=true;
      end
     else
      begin
        writeln();
        writeln('Неправильный ввод, только Y или N');
      end;
   end;
end;
 
function checkfile(s:string):boolean;                //есть ли файл
var check:text;
begin
  assign(check,s);
  {$I-}
   reset(check);
  {$I+}
  if IOResult<>0
  then
   checkfile:=false
  else
   begin
     checkfile:=true;
     close(check);
   end;
end;
 
function openinput(var infile:text):boolean;                          //откр. вх. файла
var s1:string;
begin
  writeln();
  writeln('Введите путь до входного файла ');
  readln(s1);
  if checkfile(s1)
  then
   begin
     openinput:=true;
     assign(infile,s1);
   end
  else
   begin
     writeln('Файл не существует, указать путь заного? (Y/N) Если N, программа завершится');
     if agree
     then
      openinput:=openinput(infile)
     else
      openinput:=false;
   end;
end;
 
function openoutput(var outfile:text):boolean;                         //откр. вых. файла
var s2:string;
begin
  writeln();
  writeln('Введите путь до выходного файла ');
  readln(s2);
  if not checkfile(s2)
  then
   begin
     writeln('Файл не существует, указать путь заного? (Y/N) Если N, файл будет создан');
     if agree
     then
      openoutput:=openoutput(outfile);
   end
  else
   begin
     openoutput:=true;
     assign(outfile,s2);
   end;
end;
 
procedure opencon();                                    //откр. консоли
begin
  close(input);            // закрыть предыдущий файл на вход
  close(output);           // закрыть предыдущий файл на выход
  assign(input,'CON');        // открыть
  assign(output,'CON');       // консоль
  reset(input);               // на ввод
  rewrite(output);            // и вывод
end;
 
function readtext(var s:array of string;var infile:text):boolean;   //считывание в массив
var c:char;
    probel:boolean;
    i,j:longint;
begin
  reset(infile);
  i:=1;
  j:=1;
  probel:=true;
  while not eof(infile) do
   begin
     read(infile,c);
     if (c<>' ') and (ord(c)<>13) and (ord(c)<>10)
     then
      begin
        s[i]:=s[i]+c;
        probel:=false;
      end
     else
     if ((c=' ') or (ord(c)=13) or (ord(c)=10)) and (probel=false)
     then
      begin
        probel:=true;
        i:=i+1;
      end
   end;
end;
 
// из массива S
// начиная с START эл-а
// до STOP эл-а
// напечатав в начале строки PROBEL_NUM пробелов
procedure writeprobel(probel_num:longint; var outfile:text);
var i:longint;
begin
  writeln();
  for i:=1 to probel_num do
   write(outfile,' ');
end;
 
procedure writeline(s:array of string; var i:longint; var outfile:text);
begin
  while s[i-1,length(s[i])]<>';' do
   begin
     write(outfile,s[i]);
     i:=i+1;
   end;
end;
 
function isword(s:string):boolean;
var i:longint;
    w: array [1..10] of string;
begin
  isword:=false;
  w[1]:='begin';
  w[2]:='var';
  w[3]:='uses';
  w[4]:='end';
  w[5]:='end;';
  w[5]:='end.';
  w[6]:='if';
  w[7]:='for';
  w[8]:='while';
  w[9]:='repeat';
  w[10]:='else';
  for i:=1 to 10 do
   if w[i]=s
   then
    isword:=true;
end;
 
procedure writetext(var s:array of string; var outfile:text);
var i,j,probel:longint;
    next:boolean;
    bpos:longint;
    num:array[1..10000] of longint;
begin
  for i:=1 to 10000 do
   num[i]:=0;
  bpos:=1;
  i:=1;
  j:=1;
  probel:=0;
  next:=true;
  while next do
   begin
     if length(s[i])=0
     then
      next:=false
     else
      begin                                   //...
        if not isword(s[i])
        then
         begin
           writeprobel(probel,outfile);
           writeline(s,i,outfile);
         end;
        if (s[i]='Program') or (s[i]='program')
        then
         writeline(s,i,outfile);
        if (s[i]='var') then
         begin
           probel:=4;
           writeline(s,i,outfile);
           while (s[i+1]<>'begin') or (s[i+1]<>'uses') do
            begin
              writeprobel(probel,outfile);
              writeline(s,i,outfile);
            end;
         end;
        if (s[i]='uses') then
         begin
           probel:=5;
           writeline(s,i,outfile);
           while (s[i+1]<>'begin') or (s[i+1]<>'var') do
            begin
              writeprobel(probel,outfile);
              writeline(s,i,outfile);
            end;
         end;
        if (s[i]='begin')
        then
         begin
           writeprobel(probel,outfile);
           write(outfile,s[i]);
           probel:=probel+2;
         end;
        if (s[i]='end') or (s[i]='end;')
        then
         begin
           writeprobel(probel,outfile);
           write(outfile,s[i]);
           probel:=probel-2;
         end;
 
      end;
    end;
end;
 
procedure format(var infile:text;var outfile:text);                                   //форматирование
var programtext:array [1..65000] of string;
    prov:longint;
begin
  readtext(programtext,infile);
  writetext(programtext,outfile);
  close(infile);
  close(outfile);
end;
 
procedure osnova(var infile:text; var outfile:text);                                   //сбор всех функций
begin
  clrscr;
  if not openinput(infile)
  then
   exit;
  openoutput(outfile);
  format(infile,outfile);
  opencon();
  writeln('Форматирование завершено');
  writeln();
end;
 
var s:string;
    f1,f2:boolean;
 
begin
  f1:=true;
  while f1 do
   begin
     osnova(infile,outfile);
     writeln('Еще раз? Y\N');
     if agree()=true
     then
      f1:=true
     else
      f1:=false;
   end;
end.