216 ошибка турбо паскаль

I was implementing adjacency list in Pascal (by first reading edge end points, and then using dynamic arrays to assign required amount of memory to edgelist of each node). The program executes fine, gives correct outputs but gives runtime error 216 just before exiting.
The code is :

type aptr = array of longint;
var edgebuf:array[1..200000,1..2] of longint;
    ptrs:array[1..100000] of longint;
    i,j,n,m:longint;
    elist:array[1..100000] of aptr;

{main}
begin
    readln(n,m);
    fillchar(ptrs,sizeof(ptrs),#0);
    for i:=1 to m do begin
    readln(edgebuf[i][1],edgebuf[i][2]);
    inc(ptrs[edgebuf[i][1]]);
    end;
    for i:=1 to n do begin
    setlength(elist[i],ptrs[i]);
    end;
    fillchar(ptrs,sizeof(ptrs),#0);

    for i:=1 to m do begin
    inc(ptrs[edgebuf[i][1]]);
    elist[edgebuf[i][1]][ptrs[edgebuf[i][1]]]:=edgebuf[i][2];
    end;

    for i:=1 to n do begin
    writeln(i,' begins');
    for j:=1 to ptrs[i] do begin
        write(j,' ',elist[i][j],' ');
    end;
    writeln();
    writeln(i,' ends');
    end;
    writeln('bye');
end.

When run on file

4 5
1 2
3 2
4 3
2 1
2 3

gives output:

1 begins
1 2 
1 ends
2 begins
1 1 2 3 
2 ends
3 begins
1 2 
3 ends
4 begins
1 3 
4 ends
bye
Runtime error 216 at $0000000000416644
  $0000000000416644
  $00000000004138FB
  $0000000000413740
  $0000000000400645
  $00000000004145D2
  $0000000000400180

Once the program says «bye», what is the program executing that is giving runtime error 216?

Модератор: Модераторы

Вернуться в Free Pascal Compiler

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 5

program sortirovki;

{$s-}

{$r-}

type

     list=^zveno;

     zveno=record

     c:byte;

     next:list

     end;

     elem=record

     sgn:boolean;

     n:integer;

     zero:boolean;

     ch:list;

     kz:integer

     end;

     structure=array [1..1500] of elem;

var

    B:structure;

    i,N,hs,M,l,prc,src,prh,srh,T:longint;

    c:char;

    p:list;

    vsgn:boolean;

function compare(var x,y:elem):boolean;  {true, esli x>y}

var px,py:list;

    fl:boolean;

begin

if x.sgn <> y.sgn then

 if x.sgn=false then compare:=true else compare:=false else

   if x.n<>y.n then

     if x.n < y.n then

       if x.sgn=false then compare:=false else compare:=true else

        if x.sgn=false then compare:=true else compare:=false else

       begin

         new(px);

         new(py);

         px:=x.ch;

         py:=y.ch;

         if x.ch^.c=0 then

         begin

           repeat

             x.ch:=x.ch^.next;

           until x.ch^.c<>0;

         end;

         if y.ch^.c=0 then

         begin

           repeat

             y.ch:=y.ch^.next;

           until y.ch^.c<>0;

         end;

         if x.ch^.c < y.ch^.c then fl:=false else fl:=true;

         while (x.ch^.c = y.ch^.c) and (x.ch<>nil) and (y.ch<>nil) do

         begin

           x.ch:=x.ch^.next;

           y.ch:=y.ch^.next;

           if x.ch^.c < y.ch^.c then fl:=false else fl:=true;

         end;

         x.ch:=px;

         y.ch:=py;

        if (x.sgn=false) and fl  then compare:=true else

         if (x.sgn=false) and not fl then compare:=false else

           if (x.sgn=true) and fl then compare:=false else compare:=true;

       end;

srh:=srh+1;

src:=src+1;

end;

procedure swap(var x,y:elem);

var z:elem;

begin

  new(z.ch);

  z.n:=x.n;

  z.kz:=x.kz;

  z.sgn:=x.sgn;

  z.zero:=x.zero;

  z.ch:=x.ch;

  x.n:=y.n;

  x.kz:=y.kz;

  x.sgn:=y.sgn;

  x.zero:=y.zero;

  x.ch:=y.ch;

  y.n:=z.n;

  y.kz:=z.kz;

  y.sgn:=z.sgn;

  y.zero:=z.zero;

  y.ch:=z.ch;

  prh:=prh+1;

  prc:=prc+1;

end;

procedure heapify(var B:structure;j:integer);

var max:integer;

begin

  if (2*j <= hs) and (not compare(B[j],B[2*j])) then max:=2*j else max:=j;

  if  (2*j+1 <= hs) and (not compare(B[max],B[2*j+1])) then max:=2*j+1;

  if j <> max then begin

    swap(B[j],B[max]);

    heapify(B,max);

  end

end;

procedure heapsort(var B:structure);

var i,l:integer;

begin

  for i:=hs div 2 downto 1 do

    heapify(B,i);

    {for l:=1 to N do

     write(a[l],’ ‘);}

  for i:=hs downto 2 do

  begin

    swap(B[1],B[i]);

    dec(hs);

    heapify(B,1);

  end;

end;

procedure chsort(var B:structure);

var i,j:integer;

begin

  i:=1;

  while i<N do

  begin

    if compare(B[i],B[i+1]) then

      begin

       j:=i;

       while (not compare(B[j+1],B[j])) and (j <> 0) do

       begin

         swap(B[j],B[j+1]);

         dec(j);

       end;

       inc(i);

      end else inc(i);

  end;

end;

function vvod(var B:structure):string;

var s:char;

    fl:boolean;

    i:integer;

    p:list;

    cp:boolean;

begin

  i:=0;

  repeat

    inc(i);

    fl:=true;

    read(s);

    if (s<>’ ‘) and (s<>’.’) then

    begin

      if s=’-‘ then begin read(s);B[i].sgn:=true; end else B[i].sgn:=false;

      if (s=’0′) and fl then B[i].kz:=B[i].kz+1 else

      begin

        B[i].n:=B[i].n+1;

        fl:=false

      end;

      if s<>’0′ then B[i].zero:=false else B[i].zero:=true;

        new(B[i].ch);

        B[i].ch^.c:=ord(s)-ord(‘0’);

        B[i].ch^.next:=nil;

        new(p);

        p:=B[i].ch;

      repeat

        read(s);

        if (s<>’ ‘) and (s<>’.’) then

        begin

          if s=’0′ then B[i].zero:=B[i].zero and true else B[i].zero:=false;

          if (s=’0′) and fl then B[i].kz:=B[i].kz+1

          else

          begin

            B[i].n:=B[i].n+1;

            fl:=false

          end;

          new(B[i].ch^.next);

          B[i].ch:=B[i].ch^.next;

          B[i].ch^.c:=ord(s)-ord(‘0’);

          B[i].ch^.next:=nil

        end;

      until (s=’ ‘) or (s=’.’);

      B[i].ch:=p;

      T:=T+1;

    end;

  until (s=’.’);

vvod:=»;

end;

begin

T:=0;

assign(input,’input.txt’);

assign(output,’output.txt’);

reset(input);

rewrite(output);

src:=0;

prc:=0;

srh:=0;

prh:=0;{

  writeln(‘Vvedite razmer massiva’);

  read(N);

  writeln(‘Vvedite elementi massiva’);

  for i:=1 to N do

  begin

    read(x[i]);

    y[i]:=x[i];

  end;

    chsort(x);

    writeln;}

     {

  writeln(‘Kolichestvo sravnenii i prisvaivanii dlya chelnok ‘,src,’ ‘,prc);

  writeln(‘Kolichestvo sravnenii i prisvaivanii dlya heapsort ‘,srh,’ ‘,prh);

  writeln(‘Rezultati sortirovki: 1)chelnok for X, 2)heapsort for Y’);

  for i:=1 to N do

    write(x[i],’ ‘);

    writeln;

  for i:=1 to N do

    write(y[i],’ ‘); }

  {probi vivoda}

  vvod(B);

  hs:=T;

  N:=T;

  heapsort(B);

  {chsort(B);}

  {writeln(prh,’ ‘,srh);}

  {writeln(B[1].ch^.c);}

  {writeln(compare(B[1],B[2]));}

  {writeln(B[1].n,’ ‘,B[2].n);}

  {writeln(B[1].ch^.next^.next^.c);}

  {writeln(compare(B[1],B[3]));}

  {writeln(T);}

  for i:=1 to T do

  begin

    new(p);

    p:=B[i].ch;

    vsgn:=true;

    while (B[i].ch<>nil) do

    begin

      if (B[i].sgn=true) and vsgn then begin vsgn:=false; write(‘-‘) end;

      write(B[i].ch^.c);

      B[i].ch:=B[i].ch^.next;

    end;

    write(‘ ‘);

    B[i].ch:=p;

  end;

  {end probi}

readln;

readln;

close(input);

close(output);

end.

uses crt;
type
breed=(dog,pudel,bolonka,kolli,rotv);
gender=(f,m);
obj=record
p1:byte;
p2:breed;
p3:string[10];
p4:byte;
p5:gender;
p6:string[10];
end;
ff=file of obj;
mas=array[1..100] of ^obj;
var
f1:ff;
i,j,n,nh,nc:byte;
a,ah,am:mas;
dub:obj;
fl:boolean;
procedure input(var fx:ff; n:byte);
var
i,j:byte;
x:obj;
begin
reset(fx);
for j:=1 to n do
begin
with x do
begin
writeln('Type for ',j,' dog');
writeln('Type Club Number');
readln(p1);
writeln('Type breed: 0-Dog, 1-Pudel, 2-Bolonka, 3-Kolli, 4-Rotveiller');
readln(i);
p2:=breed(i);
writeln('Type Name');
readln(p3);
writeln('Type age');
readln(p4);
writeln('Type gender 0-f,1-m');
readln(i);
p5:=gender(i);
writeln('Type owner"s Surname');
readln(p6);
end;
write(fx,x);
end;
end;
procedure output(var x:mas;n:byte);
var i:byte;
begin
for i:=1 to n do
with x[i]^ do
begin
writeln;
writeln('DATA for ',i,' dog');
write('Club Number: ');
write(p1,'; ');
write('Breed: ');
case p2 of
dog:write('Dog');
pudel:write('Pudel');
bolonka:write('Bolonka');
kolli:write('Kolli');
rotv:write('Rotveiller');
end;
write('; ');
write('Name: ');
write(p3,'; ');
write('Age: ');
write(p4,'; ');
write('Gender: ');
case p5 of
m:write('male; ');
f:write('female; ');
end;
write('Owner"s Surname: ');
write(p6);
end;
end;
begin
{$R-}
assign(f1, 'D:11-2dogs.pas');
rewrite(f1);
writeln('Type Number of Dogs');
readln(n);
input(f1,n);
reset(f1);
for i:=1 to n do
begin
new (a[i]);
read(f1,dub);
a[i]^:=dub;
end;
nh:=round(n/2);
for i:=1 to nh do
ah[i]:=a[i];
writeln(nh);
writeln('Type new elements count');
readln(nc);
writeln(nc);
for i:=(1) to (nc) do
begin
with ah[nh+i]^ do
begin
writeln('Type for new ',(i),' dog');
writeln('Type Club Number');
readln(p1);
writeln('Type breed: 0-Dog, 1-Pudel, 2-Bolonka, 3-Kolli, 4-Rotveiller');
readln(j);
p2:=breed(j);
writeln('Type Name');
readln(p3);
writeln('Type age');
readln(p4);
writeln('Type gender 0-f,1-m');
readln(j);
p5:=gender(j);
writeln('Type owner"s Surname');
readln(p6);
end;
end;
{1_s}
fl:=true;
while fl=true do
begin
fl:=false;
for i:=1 to n do
if (a[i]^.p4)>(a[i+1]^.p4) then
begin
dub:=a[i]^;
a[i]^:=a[i+1]^;
a[i+1]^:=dub;
fl:=true;
end;
end;
{2_s}
fl:=true;
while fl=true do
begin
fl:=false;
for i:=1 to (nh+nc) do
if (ah[i]^.p1)<(ah[i+1]^.p1) then
begin
dub:=ah[i]^;
ah[i]^:=ah[i+1]^;
ah[i+1]^:=dub;
fl:=true;
end;
end;
clrscr;
output(a,n);
writeln;
output(ah,(nc+nh));
writeln;
{$R+}
end.

вылетает с ошибкой 216 после 108 строчки

Код

writeln(nc);

Что делать?

  unit matrix;
  interface
  uses crt;
  type
  TInt = integer;
  TLInt = longint;
  TSingle = single;
  TElem = TSingle;
  TLine = array [1..1] of TElem;
  PLine = ^TLine;
  TCol = array [1..1] of PLine;
  PCol = ^TCol;
 
  PCmatr = ^Cmatr;
  Cmatr = object
  private
        Fstr:word;
        Fstc:word;
        FMatr:PCol;
        procedure F(err:byte);
  public
        constructor CreateMatr(w,h:TInt); //выделение памяти под матрицу
        destructor done(); //уничтожение матрицы, освобождение памяти
        procedure putElem(i,j:word; elem:TElem);
        procedure getElem(i,j:word; var e:TElem);
        function getstr:word;
        function getstc:word;
 
  end;
 
  implementation
  {$R-}
        function Cmatr.getstr:word;
          begin
          getstr:=Fstr;
          end;
 
        function Cmatr.getstc:word;
          begin
          getstc:=Fstc;
          end;
 
        procedure Cmatr.F(err:byte);
                begin
                case err of
                1 : writeln('Ошибка выделения памяти');
                end;
        end;
 
        constructor Cmatr.CreateMatr(w,h:TInt);
        var i:TLint;
                begin
                Fstr:=w;
                Fstc:=h;
                getmem(FMatr, Fstr * sizeof(PLine)); //выделение памяти под строки
                if Fmatr <> NIL then
                  begin
                   for i:=1 to Fstr do
                    begin
                     getmem(FMatr^[i], Fstc * sizeof(TElem));//под столбцы
                     writeln('память ',i);
                     delay(1000);
                     if Fmatr^[i] = NIL then
                     begin
                        F(1);
                        delay(2000);
                        halt(1);
                     end;
                   end;
                end
                else
                  begin
                   F(1);
                   delay(2000);
                   halt(1);
                  end;
                end;
 
         destructor Cmatr.done();
         var i:TInt;
         begin
 
                for i:=1 to Fstr do
                 begin
                 freemem(Fmatr^[i],Fstc * sizeof(TElem));
                 end;
         freemem(Fmatr, Fstr * sizeof(PLine));
         end;
 
         procedure Cmatr.putElem (i,j:word; elem:TElem);
            begin
             Fmatr^[i]^[j]:=elem;
            end;
 
         procedure Cmatr.getElem (i,j:word; var e:Telem);
            begin
             e:=Fmatr^[i]^[j];
            end;
         end.

program cursortest;
uses crt,matrix;
type
TChar = char;
TInt = integer;
TDouble = double;
const h = 10; w = 10;
var ch:char;
    x,y,i,j,k,l:integer;
    FMatr:PCmatr;
//    Matr:Cmatr;
        procedure cursor(var x,y:integer);
        begin
        gotoxy(x,y);
        write('->');
        end;
 
        procedure moving(var x,y,k,l:TInt; ch:TChar);
        begin
       // ch:=readkey;
        gotoxy(x,y);
        textcolor(black);
        write('->');
        textcolor(white);
        case ch of
        'w', 'W', 'Ц' , 'ц' , #72: if (y>1) then begin y:=y-1; l:=l-1; end;
        's', 'S', 'Ы' , 'ы' , #80: if (y<40) and (l<w) then begin y:=y+1; l:=l+1; end;
        'a', 'A', 'Ф' , 'ф' , #75: if (x>5) then begin x:=x-5; k:=k-1; end;
        'd', 'D', 'В',  'в' , #77: if (x<115) and (k<h) then begin x:=x+5; k:=k+1; end;
        end;
        end;
 
        procedure fillArr (var FMatr:PCmatr) ;
        var n,m,i,j:TInt;
        eleme:TElem;
        begin
        randomize;
        clrscr;
        writeln('Введите размеры матрицы');
        read(n,m);
        FMatr^.createMatr(n,m);
        for i:=1 to n  do
        begin
          for j:=1  to m do   begin
                eleme:=(random(1000)/(random(100)+1));
                write('Присвоил элемент');
                delay(1000);
                FMatr^.putElem(i,j,eleme);
                write('Закинул в массив');
                delay(1000);
                end;
        end;
        end;
 
        procedure printArr ();
        var i,j:TInt;
        el:TElem;
        begin
        gotoxy(1,1);
        for i:=1 to FMatr^.getStr() do
        begin
        for j:=1 to FMatr^.getStc() do
        begin
        FMatr^.getElem(i,j,el);
        write(el:5:0, ' ');
        end;
        writeln;
        end;
        end;
 
        procedure changeElem(var FMatr:PCMatr; l,k:TInt);
        var el:single;
          begin
          if ch = ' ' then begin
          read(el);
          FMatr^.putElem(l,k,el);
          end;
          end;
 
    begin
 
    clrscr;
    write(1);
    delay(2222);
    fillArr(FMatr);
    write(2);
    delay(2222);
    gotoxy(1,1);
    write('#');
    cursoroff;
    x:=1; y:=1;
    k:=1; l:=1;
    while not (ch=#27) do begin
        printArr();
        cursor(x,y);
        gotoxy(5,30);
        write(l:3,k:3);
        ch:=readkey;
        moving(x,y,k,l,ch);
        changeElem(FMatr,l,k);
       delay(20);
    end;
    FMatr^.done();
       end.