Списки. Представление однородными массивами фиксированного размера (Копирование списка)

[pitak]

Здравствуйте. Задание: Написать программу копирования списка. В программе нужно использовать модуль ds_unit, текст которого дан. Как я понимаю, нужно задать два списка и информационное поле первого скопировать в информационное поле второго.

Делаю вот так:

program ds_01;
uses ds_unit;
var    first: integer;
       second: integer;
procedure copy_spis(lst, lst_dva:integer);
var p, k: integer;
begin
   p:=lst;
   k:=lst_dva;
   while p<>0 do begin info[k]:=info[p]; p:=link[p]; k:=link[k]; end;
end;
begin
    rdblock;
    write('First: '); readln(first);
    write('Second: '); readln(second);
    copy_spis(first,second);
    wrblock;
    writeln('Second: ',second);
    escwait;
end.

Здесь p-это указатель на 1 элемент первого списка, k - указатель на 1 элемент второго списка. Т.е. пишу, что пока указатель на 1 элемент первого списка не равен 0, информационному полю второго списка присваиваем значение информационного поля первого, далее переходим на следующий элемент.

В результате получается какая-то ерунда, хотя, возможно, дело в неправильном выводе результата на экран.

Просьба подсказать:
1. Какая ошибка в процедуре;
2. Как правильно вывести результат на экран.

[pitak]

Тест модуля ds_unit (для данной задачи используется только часть модуля, остальное - это для других задач):

UNIT DS_UNIT;
interface
uses crt;
const m=7; { Размер блока памяти выделенного
             для представления списков }
var info: array[1..m] of integer;{ Массив полей информации }
    link: array[1..m] of integer;{ Массив полей связи для представления списков }
    avail: integer; { Список свободного пр-ва }
 
type plist = ^list; { Тип указателя на список }
    list = record  { Тип элемента списка }
        info: integer; { Поле информации }
        link: plist; { поле связи элеменета списка}
    end;
 
type ptree = ^tree; { Тип указателя на дерево }
     tree =  record { Тип элемента дерева }
             llink,rlink: ptree; { Левое и правое поля связи элемента дерева }
             info: char; {Поле информации элемента}
     end;                {         дерева         }
 
procedure escwait; { Приостановка выполнения программы }
procedure rdblock; { Ввод и                       }
procedure wrblock; { вывод состояния блока памяти }
                   { для представления списков    }
procedure rdlist(var lst: plist); { Ввод и        }
procedure wrlist(lst: plist);  { вывод списка lst }
procedure gentree(var t:ptree); { Ввод и          }
procedure puttree(t:ptree);     { вывод дерева t  }
 
implementation
 
procedure escwait;
var fin: Boolean;
begin
    writeln;
    writeln('Нажмите Esc для продолжения программы.');
    repeat
        repeat until keypressed;
        fin:=ord(readkey)=27;
    until fin;
end; {escwait}
 
procedure rdblock;
var i: integer;
begin
    writeln;
    writeln('Ввод состояния блока памяти...');
    writeln('  В строках Info и Link вводите по ',m:2,' чисел,');
    writeln('                        разделяя их пробелами...');
    write('      '); 
    for i:=1 to m do write(i:3);
    writeln; write('Info: '); 
    for i:=1 to m do read(info[i]);
    write('Link: '); 
    for i:=1 to m do read(link[i]);
    write('Avail: '); readln(avail); writeln;
end; {rdblock}
 
procedure wrblock;
var i: integer;
begin
    writeln; writeln('Состояние блока памяти...');
    write('      '); 
    for i:=1 to m do write(i:3);
    writeln; write('Info: '); 
    for i:=1 to m do write(info[i]:3); 
    writeln;
    write('Link: '); 
    for i:=1 to m do write(link[i]:3); 
    writeln; writeln('Avail: ',avail);
end; {wrblock}
 
procedure rdlist(var lst: plist);
var p,q,s: plist;
    buf: integer;
    function rdint(var buf:integer):Boolean;
    begin
        {$i-}
        read(buf);
        rdint:=IOResult=0;
        {$i+}
    end; {rdint}
begin
    writeln;
    writeln('Ввод списка... ');
    writeln('   Вводите элементы списка (целые числа),');
    writeln('   разделяя их пробелами. За последним');
    writeln('   числом списка введите пробел, точку и Enter!');
    q:=nil;
    while rdint(buf) do
    begin
        new(s);
        s^.info:=buf;
        s^.link:=q;
        q:=s;
    end;
    p:=nil;
    while q<>nil do
    begin
        s:=q; q:=q^.link;
        s^.link:=p; p:=s;
    end;
    lst:=p;
end; {rdlist}
 
procedure wrlist(lst: plist);
var p: plist;
begin
    write('Список: [');
    p:=lst;
    while p<>nil do
    begin
        if p<>lst then write(',');
        write(p^.info);
        p:=p^.link;
    end;
    writeln(']');
end; {wrlist}
 
procedure gentree(var t:ptree);
    procedure gent(var t:ptree);
    var ch: char;
    begin
        read(ch);
        if ch='.' then begin t:=nil; exit end;
        new(t); t^.info:=ch;
        gent(t^.llink);
        gent(t^.rlink);
    end; {gent}
begin
    writeln;
    writeln('Ввод дерева в точечной форме');
    writeln('          ( например,  AB..C.. )...');
    gent(t);
    readln;
    writeln;
end; {gentree}
 
procedure puttree(t:ptree);
    procedure putt(t:ptree);
    begin
        if t=nil then begin write('.'); exit end;
        write(t^.info);
        putt(t^.llink);
        putt(t^.rlink);
    end; {putt}
begin
    writeln;
    writeln('Дерево:');
    putt(t);
    writeln;
end; {puttree}
end.