программа вылетает через несколько циклов

Как я понял проблема происходит в этой части кода.

  WHILE NOT EOF(FIn)
  DO
    BEGIN    
      READLN(FIn, Str);      
      Str := Str + ' ';
      Str := AnsiLowerCase(Str);
      Signedness(Str);
      WHILE Add(Str)
      DO
        BEGIN
          AddMas(CreateWord(Str), WordList, WordCount);
          I := I + 1;
          IF (WordList[Max] <> '') OR (I = Max) 
          THEN
            BEGIN
              Sort(WordList, WordCount);             
                  Print(FOut, WordList, WordCount);
                  Merge(F, FOut);  
              FOR I := Start TO Max
              DO
                BEGIN
                  WordList[I] := '';
                  WordCount[I] := 0
                END;
              writeln('1');   
              I := 0
            END                         
        END                                    
    END;

BEGIN {AddMas}
  I := Start;
  WHILE (I <= Count) AND (WordList[I] <> Str) 
  DO 
    I := I + 1;
  IF I <= Count 
  THEN 
    WordCount[I] := WordCount[I] + 1
  ELSE 
    BEGIN
      Count := Count + 1;
      WordList[Count] := Str;
      WordCount[Count] := 1
    END
END; {AddMas} 

BEGIN {Merge}
  RESET(FIn);
  WHILE NOT EOF(FIn)
  DO
    BEGIN
      READLN(FIn, Str1);
      WRITELN(FOut, Str1)
    END;         
END; {Merge}

после 3 проходов программа вылетает без описания какой либо ошибки. файлы которые подаются на вход много больше количества элементов в массивах. merge - скидывает данные из файла в другой файл.