Сортировка вставками

[HailMe]

Здравствуйте. Нужно отсортировать слова в тексте методом простых вставок, по алфавиту. Перед сортировкой нужно слова из текста перенести в другой файл, в формате "Слово НомерВТексте".
Пытался использовать двухсвязный список. Пишу в ABC.NET. Сортировать может только при 529 словах в файле максимум. Больше - никуда. Пишет System.ExecutionEngineException. В самом тексте для сортировки около 1800 слов. Проблема в среде или в оптимизации и как можно это исправить?

PHP код:

type
  words = record
    inf: integer;
    wrd: string;
    nmb:integer;
  end;
  
  plist = ^tlist;
  tlist = record
    data: words;
    next, prev: plist;
  end;
  
  p2list = ^plist;


procedure Display(list: plist);
var
 
  p: plist;
begin
 
  if list = nil then
    writeLn('EMPTY')
  else
  begin
    p := list;
    
    while p^.prev <> nil do
      p := p^.prev;
    
    while p <> nil do
    begin
      if (p^.data.wrd = 'Begin') then p := p^.next;
      writeln(p^.data.wrd,' ',p^.data.inf);
      p := p^.next;
      if (p^.data.wrd = 'яяяяяяяяя') then Break;
    end
  end;
end;

procedure AddToEnd(list: p2list; d: integer; s: string);
var
  prior: plist;
begin
  prior := nil;
  
  while list^ <> nil do
  begin
    prior := list^;
    list :=  @list^^.next
  end;
  
  New(list^);
  
  with list^^ do
  begin
    data.inf := d;
    data.wrd := s;
    data.nmb := d;
    next := nil;
    prev := prior
  end
end;





procedure Sort(list: plist; n:integer);
label m;
  
  function Check(a, b: string): boolean;
  var
    i: integer;
  begin
    i := 1;
    
  for i:=1 to Length(a) do begin  
    if a[i] = b[i] then continue
    else if a[i] < b[i] then begin Check := false; break; end
    else begin Check := true; break; end
  end;
  end;



var
  p: plist;
  s: string;
  i: integer;
  save1, save2: words;

begin
  p := list;
  
  while p <> nil do 
  begin
    
    for i := 1 to n do  
    begin
     
      
      
      if p^.data.nmb > i then begin
        repeat
          p := p^.prev;
        until p^.data.nmb = i;
      end;
      
      if p^.data.nmb < i then begin
        repeat
          p := p^.next;
        until p^.data.nmb = i;
      end;
      
      if (p^.next)^.data.wrd = 'яяяяяяяяя' then goto m;
      
      if  (Check(p^.data.wrd, (p^.next)^.data.wrd)) = true then begin
        
        save1 := p^.data;
        p := p^.next;
        save2 := p^.data;
       p^.data.wrd := save1.wrd;
       p^.data.inf := save1.inf;
       p := p^.prev;
       p^.data.inf := save2.inf;
       p^.data.wrd := save2.wrd;
        
        
      end;
      
      p := p^.next;
      if p^.data.nmb = 0 then goto m;
      
      if  (Check(p^.data.wrd, (p^.next)^.data.wrd)) = true then begin
        
        save1 := p^.data;
        p := p^.next;
        save2 := p^.data;
       p^.data.wrd := save1.wrd;
       p^.data.inf := save1.inf;
        p := p^.prev;
       p^.data.inf := save2.inf;
       p^.data.wrd := save2.wrd;  
      end; 
         repeat
        if  (((p^.prev)^.data.nmb)<>0) and ((Check((p^.prev)^.data.wrd, (p^.data.wrd))) = true) then begin
          p := p^.prev;   
          save1 := p^.data;
          p := p^.next;
          save2 := p^.data;
          p^.data.wrd := save1.wrd;
          p^.data.inf := save1.inf;
          p := p^.prev;
          p^.data.wrd := save2.wrd;
          p^.data.inf := save2.inf;
          
        end
      until (Check((p^.prev)^.data.wrd, (p^.data.wrd))) = false;
      
    end;
  end;
  m:  end;

var
  list: plist;
  i, n, h, j, err,l: integer;
  f,g: text;
  str1, str2, str3, str4,str5, str6: string;

begin
  n:=1;
  AddToEnd(@list, 0, 'Begin');
  
  assign(g, 'D:\PASCAL\g.txt');
  reset(g);
  assign(f, 'D:\PASCAL\f.txt');
  rewrite(f);
  
  while not (EOF(g)) do
  begin
    
    readln(g, str1);
    
    str2 := str1;
    
    if str2='' then continue;
    
    if str2[length(str2)] <> ' ' then
      str2 := str2 + ' ';
    
    i := 1;
    
    repeat
      if str2[i] = ' ' then begin
        str3 := copy(str2, 1, i);
       
       for l:=1 to length(str3) do
        str3[l]:=LowCase(str3[l]);
       
        delete(str2, 1, i);
        if str3<>'— ' then begin
        
        writeln (f,str3,n);
        n:=n+1;
        end;
        i := 0;
      end;
      i := i + 1;
    until str2 = '';
    
  end;
  close (f);
  assign(f, 'D:\PASCAL\f.txt');
  reset (f);
  
  while not  EOF(f) do begin
   readln (f,str4);
   h:=Length(str4);
    for i:=1 to h do begin
     if str4[i]=' ' then begin
      str5:=copy(str4,1,i);
      str6:=copy(str4,i+1,h);
      Val(str6,j,err);
      AddToEnd(@list, j, str5);
      end;
     end;    
   
   end;  
  
  AddToEnd(@list, 0, 'яяяяяяяяя');
  
  Display (list);
  writeln;
  Sort(list, n);
  
end.