При вычислении факториала больше пяти сот восьми (508), происходит зацикливание

program Factorial;
const max=1000;
var mnimN:array[1..max] of extended;
    N:array[1..max] of shortint;
    F:array[1..max] of extended;
    m, N1:extended;
    k: longint;
    dlinaF, dlinaN, i, j: integer;
begin
 repeat
  begin
 write('Vvedite celoe N ot 1 do 508 vklychitelno: ');
 readln(j)
  end;
 until (j>0) and (j<=508);
 m:=j;
 dlinaN:=1;
 while m>=10 do
  begin
  m:=trunc(m) div 10;
  dlinaN:=dlinaN+1;
  end;
 for i:=1 to max do
  begin
  mnimN[i]:=0;
  N[i]:=0;
  F[i]:=0;
  end;
 F[1]:=1;
 for i:=1 to dlinaN do
  begin
  N[i]:=j mod 10;
  j:=j div 10;
  end;
 while (N[1]<>1) or (dlinaN>1) do
  begin
   k:=max;
   while (k>0) and (F[k]=0) do k:=k-1;
   dlinaF:=k;
   k:=max;
   while (k>0) and (N[k]=0) do k:=k-1;
   dlinaN:=k;
   for i:=1 to max do
    begin
    mnimN[i]:=F[i];
    F[i]:=0;
    end;
   for i:=1 to dlinaF do
    begin
    m:=0;
    for j:=1 to dlinaN do
     begin
     k:=trunc(mnimN[i])*N[j]+trunc(m)+trunc(F[i+j-1]);
     F[i+j-1]:=trunc(k) mod 10;
     m:=trunc(k) div 10;
     end;
     F[i+j]:=m;
    end;
   N[1]:=N[1]-1;
   for i:=1 to dlinaN do
    begin
    if N[i]<0 then
    begin
    N[i]:=N[i]+10;
    N[i+1]:=N[i+1]-1;
    end;
   end;
  end;
  k:=max;
  while (k>0) and (F[k]=0) do k:=k-1;
  dlinaF:=k;
  k:=0;
  writeln;
  writeln('Faktorial ot N raven:');
  for i:=dlinaF downto 1 do write(F[i]:1:0);
  writeln;
  for k:=max downto 1 do
   begin
   for i:=1 to k-1 do
    begin
    if F[i]>F[i+1] then
     begin
     m:=F[i];
     F[i]:=F[i+1];
     F[i+1]:=trunc(m);
     end;
    end;
   end;
  writeln;
  writeln('Otsortirovanniy massiv iz faktoriala:');
  for i:=max-dlinaF+1 to max do write(F[i]:1:0);
  readln;
  end.

programm aaaaa;
{$N+}