Длинная арифметика. Деление длинного числа на короткое., Помогите найти ошибку в программе. Опции

[Gordey]

Нашел программу, которая должна считать частное от деления длинного числа на короткое, но она не работает, помогите найти ошибку пожалуйста.
В общем вот текст программы:

const osn = 10000;
      max = 2502;
type
    Tlong = array[0..max] of longint;

procedure swap( var a,b;
                size: integer);
var
p: pointer;
begin
     getmem(p,size);
     move(a, p^, size);
     move(b,a, size);
     move(p^, b, size);
     freemem(p, size);
end;


procedure delenie( a:Tlong;
                   b:longint;
                   var c:Tlong);
var
p:longint;
i, j, ost: integer;
begin
     fillchar(c, sizeof©, 0);
     p:=0;
     i:=1;
     j:=a[0];
     while i<j do
     begin
          swap (a[i], a[j], sizeof(a[i]));
          inc(i);
          dec(j);
     end;
     ost:=0;
     for i:=1 to a[0] do
     begin
          c[i]:=(longint(ost)*osn + a[i]) div b;
          ost:=(longint(ost)*osn + a[i]) mod b;
     end;
     if c[1]=0 then
        begin
             c[0]:=a[0]-1;
             for i:=1 to c[0] do c[i]:=c[i+1];
             c[c[0]+1]:=0;
        end;
     if c[1]<>0 then c[0]:=a[0];
     i:=1;
     j:=c[0];
     while i<j do
     begin
          swap(c[i],c[j], sizeof(a[i]));
          inc(i);
          dec(j);
     end;
end;

.

Сообщение отредактировано: Gordey - 18.06.2011 19:46

[Gordey]

Turbo Pascal 7.0.

 {$A+,B-,D+,E+,F-,G-,I+,L+,N+,O-,P-,Q-,R-,S+,T-,V+,X+}
{$M 65384,0,655360}
program Pi;
const osn = 10000;
      max = 2502;
type
    Tlong = array[0..max] of longint;
var p, z, m, a, summa1: Tlong;
    q, x, y, n: longint;



procedure readlong(var a:Tlong);
var ch:char;
    i: longint;
begin
     fillchar(a, sizeof(a), 0);
     {3apoln9em massiv nul9mi}
     read(ch);
     while not (ch in ['0'..'9']) do read(ch);
     {propuskaem ne simvoli}
     while ch in ['0'..'9'] do
     begin
          for i:=a[0] downto 1 do
          begin
               a[i+1]:=a[i+1] + (longint(a[i])*10) div osn;
               {dobavl9em odnu cifru  iz tekushego r9da v sleduushii}
               a[i]:=(longint(a[i])*10) mod osn;
               {ubiraem odnu cifru iz tekushego}
          end;
          a[1]:=a[1] + ord(ch) - ord('0');
          {v konec 1 r9da zapisivaem polu4ennuu cifru}
          if a[a[0]+1]> 0 then inc(a[0]);
          {esli mi zan9li eshe 1 eleement massiva, to uveli4ivaem nulevoi element}
          read(ch);
          {4itaem o4erednoy simvol}
     end;
end;


procedure writelong( Var a: Tlong);

var
ls, s : string;
i:longint;
begin
     str(osn div 10,ls);
     write(a[a[0]]);
     {vivodim starshie 4isla}
     for i:=a[0]-1 downto 1 do
     begin
          str(a[i],s);
          while length(s)<length(ls) do s:='0'+s;
          write(s);
     end;
     writeln;
end;


procedure summa(a, b: Tlong;
                var c: Tlong);
var i, k: longint;
begin
     fillchar(c, sizeof©, 0);
     if a[0] > b[0] then k:= a[0] else k:=b[0];
     for i:=1 to k do
         begin
              c[i+1]:=(c[i] + a[i] + b[i]) div osn;
              c[i]:=(c[i] + a[i] + b[i]) mod osn;
         end;
     if c[k+1]=0 then c[0]:=k else c[0]:= k+1;
end;


procedure vi4itanie ( var a, b: Tlong;
                      var c: Tlong);

var k,i,p: longint;
begin
     fillchar(c,sizeof©,0);
     if a[0]>b[0] then k:=a[0] else k:=b[0];
     p:=0;
     for i:=1 to k do
          begin
          c[i]:=a[i]-b[i]-p;
          if c[i]<0 then
          begin
               p:=1;
               inc(c[i],osn);
          end;
          if c[i]>0 then p:=0;
    end;
    for i:=k downto 1 do
    if c[i]<>0 then break;
    c[0]:=i;
end;


procedure umnojenie( const a:Tlong;
                     const k: longint;
                     var c: Tlong);
var i: longint;
{nujnoe 4islo -  c}
begin
     fillchar(c, sizeof©, 0);
     if k=0 then inc(c[0]){umnojenie na 0}
     else begin
               for i:=1 to a[0] do
               begin
                    c[i+1]:=(longint(a[i])*k + c[i]) div osn;
                    c[i]:=(longint(a[i])*k + c[i]) mod osn;
               end;
     if c[a[0]+1]>0 then c[0]:=a[0]+1
     else c[0]:=a[0]; {smotrim na dlinu polu4ivshegos9 4isla}
end;
end;


procedure swap( var a,b;
                size: integer);
var
p: pointer;
begin
     getmem(p,size);
     move(a, p^, size);
     move(b,a, size);
     move(p^, b, size);
     freemem(p, size);
end;


{function delenie(a: Tlong; b:integer): Tlong;
var i, ost: integer;
const base :10;
begin
     ost:=0;
     fillchar(result, sizeof(result), 0);
     for i:= a[0] downto 1 do
     begin
          result[i]:=(a[i] +ost*base);
          ost:= result[i] mod b;
          result[i]:= result[i] div b;
     end;
     result[0]:=a[0];
     while result[result[0]] = 0 do dec (result[0]);
end;}





begin
for q:=0 to 2502 do
begin
     if q=0 then a[q]:=2502;
     if q=2502 then a[q]:=1;
     if (q<>0) and (q<>2502) then a[q]:=0;
end;
writelong(a);
readln;
end. 

На основную программу не смотри, она мне не нужна.



Сообщение отредактировано: Gordey - 19.06.2011 13:48